C,

You will have to provide some or all of the following
information to get someone to try and help.

What is the problem that occurs?
What code line generates the error?
What is the error number and message?
What is the Excel version and operating system version?

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Hi,

I have a problem with a German VB file which I am sure is related to
the time and date format used in the UK dd.mm.yyyy

If i sent my PC to location Germany then the code works.

Can any help, here is the code

'**************************************
'Version 1.03

'Public Const LOCALE_SSHORTDATE = &H1F

Public Declare Function GetSystemDefaultLCID _
 Lib "kernel32" () As Long

Public Declare Function SetLocaleInfo _
   Lib "kernel32" Alias "SetLocaleInfoA" ( _
   ByVal Locale As Long, _
   ByVal LCType As Long, _
   ByVal lpLCData As String) As Boolean

Public box3, box4_1, box4_0 As Variant

'***********ADD IN**********************
'automated macro to make a new taskbar entry
'***************************************
'#1
Sub Auto_open()

 Application.DisplayAlerts = False
 Dim ComBar As CommandBar

 On Error GoTo ErrLabel

 'make a new taskbar entry "Call Detail Records
 'with sub entries "Load Data" and "Save Data"
 Const MenueName = "Call Detail Records"

 'count entries with name "Call Detail Records"
 Dim i
 i = 0
 For Each ComBar In Application.CommandBars
  If ComBar.Name = "Call Detail Records" Then
   i = i + 1
  End If
 Next
 'if entry already existe, delete all entries
 If i > 0 Then
   ComBar.Delete
 Exit Sub
 i = 0
 End If

 'create new entry
 With Application.MenuBars(xlWorksheet)
     .Menus.Add Caption:=MenueName
     '.Menus(MenueName).MenuItems.Add Caption:="Load CDR Version
3.20", OnAction:="WarningMessageV3"
     .Menus(MenueName).MenuItems.Add Caption:="Load CDR",
OnAction:="WarningMessageV4_0"
     '.Menus(MenueName).MenuItems.Add Caption:="Load CDR Version
4.10", OnAction:="WarningMessageV4_1"
     .Menus(MenueName).MenuItems.Add Caption:="Save Data",
OnAction:="SaveData"
 End With

 'delete 3rd worksheet
 Dim wkstemp
 Set wkstemp = Application.ActiveWorkbook.Worksheets(3)
 wkstemp.Select

 Application.DisplayAlerts = False
 ActiveWindow.SelectedSheets.Delete
 Application.DisplayAlerts = True

ErrLabel:
End Sub

'****LOAD USERFORM**********************
'calls UserForm to choose the starting and finish date
'***************************************
'#2
Sub LoadDialog_Load()

 LoadDialog.CalendarStart.value = Now
 LoadDialog.CalendarFinish.value = Now
 'Ian Rowan
 LoadDialog.txtInputPathName.value = "\\avebury\swyx\"
 LoadDialog.Show

End Sub
'#4
Sub WarningMessageV4_0()

 box4_0 = 1
 Call LoadDialog_Load

End Sub
'#5
Sub WarningMessageV4_1()

 box4_1 = 1
 Call LoadDialog_Load

End Sub

'***********LOAD DATA*******************
'main macro to load and format the call detail records
'***************************************
'#6
Sub LoadData()

 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 'Show text of Label in Userform
 LoadDialog.Label5.Visible = True
 LoadDialog.Repaint

 '***********DECLARATION*****************
 '***************************************

 'worksheets
 Dim wks1 As Worksheet
 Dim wks2 As Worksheet
 Dim wks3 As Worksheet

 'of columns of Origination Nr & Name, Destination Nr & Name
 'Start Date & Time, End Date & Time, Duration (SumDif between Start
time
 ' & end time), Currency, Costs, State, Public Access Prefix, Project
Number,
 'AOC for wks1
 Dim xColOrigiNum&
 Dim xColOrigiName&
 Dim xColCalledNum&
 Dim xColCalledName&
 Dim xColDestNum&
 Dim xColDestName&
 Dim xColStartDate&
 Dim xColStartTime&
 Dim xColEndDate&
 Dim xColEndTime&
 Dim xColSumDif&
 Dim xColCurrency&
 Dim xColCosts&
 Dim xColState&
 Dim xColPAP&
 Dim xColLCR&
 Dim xColProjNum&
 Dim xColAOC&
 Dim xColOrigiDevice&
 Dim xColDestDevice&

 'statistics
 Dim xColStatistics&   '= xColOrigiNum&
 Dim xColStatistics2&
 Dim xColResults&      '= xColOrigiName&
 Dim xColResultsInt2&
 Dim xColResultsExt2&

 Dim xRowStatistics&
 Dim xRowAllCalls&
 Dim xRowIntCalls&
 Dim xRowExtCalls&
 Dim xRowCosts&
 Dim xRowCostCalls&
 Dim xRowTime&
 Dim xRowDurCalls&

 Dim xRowStatus&
 Dim xRowExtConnected&
 Dim xRowExtAlerting&
 Dim xRowExtInit&
 Dim xRowExtHold&
 Dim xRowExtTransf&

 'Time Per Call (= sumdiff ), Costs Per Name for wks2
 Dim xColDestNum2&
 Dim xColDestName2&
 Dim xColStartDate2&
 Dim xColStartTime2&
 Dim xColTimePerCall&
 Dim xColCostsPerName&

 'rows
 Dim xRowHeader&     'first row for header
 Dim xRowFirst&      'second row = first row to insert cdr
 Dim xRowLast&       'last written row
 Dim xRowTotal&      'row after xRowLast& to calculate total time and
costs
 Dim xRowActive&     'current active row
 Dim xRowTemp&

 'current caller name
 Dim xColOrigiNameValue As Variant

 'results wks1
 Dim xSumDif#
 Dim xTotalTime#
 Dim xTotalCosts#

 'statistics wks1

 Dim xAllCalls#
 Dim xDurCalls#
 Dim xIntCalls#
 Dim xExtCalls#
 Dim xCostCalls#

 Dim xExtConnected#
 Dim xExtAlerting#
 Dim xExtInit#
 Dim xExtHold#
 Dim xExtTransf#

 Dim xIntConnected#
 Dim xIntAlerting#
 Dim xIntInit#
 Dim xIntHold#
 Dim xIntTransf#

 Dim beginDate
 Dim endDate

 '***********INITIALIZATION**************
 '***************************************

 'Set fixed german date format for all date operations,
 'since Swyx Server creates CDR files with fixed german
 'date format !
' Dim lngLocale As Long
' lngLocale = GetSystemDefaultLCID()
 'bReturn = SetLocaleInfo(lngLocale, LOCALE_SSHORTDATE, "MM.dd.yyyy")

 'initialize rows
 xRowHeader& = 1
 xRowFirst& = 2
 xRowTemp& = 2

 'initialize columns for wks1
 xColOrigiNum& = 1
 xColOrigiName& = 2
 xColOrigiDevice& = 3
 xColCalledNum& = 4
 xColCalledName& = 5
 xColDestNum& = 6
 xColDestName& = 7
 xColDestDevice& = 8
 xColStartDate& = 9
 xColStartTime& = 10
 xColEndDate& = 11
 xColEndTime& = 12
 xColSumDif& = 13
 xColCurrency& = 14
 xColCosts& = 15
 xColState& = 16
 xColPAP& = 17
 xColLCR& = 18
 xColProjNum& = 19
 xColAOC& = 20

 'Statistics
 xColStatistics& = 1
 xColResults& = 2
 xColStatistics2& = 4
 xColResultsInt2& = 5
 xColResultsExt2& = 6

 'wks2
 xColDestNum2& = 3
 xColDestName2& = 4
 xColStartDate2& = 5
 xColStartTime2& = 6
 xColTimePerCall& = 7
 xColCostsPerName& = 8

 'define workbook with its worksheets
 ActiveWorkbook.Author = "Eve*"
 Set wks1 = Application.ActiveWorkbook.Worksheets(1)
 Set wks2 = Application.ActiveWorkbook.Worksheets(2)
 Set wks3 = Application.ActiveWorkbook.Worksheets(3)
 wks1.Cells.Delete Shift:=xlUp
 wks2.Cells.Delete Shift:=xlUp
 wks3.Cells.Delete Shift:=xlUp

 'format worksheets
 wks1.Name = "CDR Total"
 wks2.Name = "CDR per Name"
 wks3.Name = "Profile"
 wks1.Cells.NumberFormat = "General"
 wks2.Cells.NumberFormat = "General"
 wks3.Cells.NumberFormat = "General"

 'format columns "@" = Stringformat
 wks1.Columns("A").NumberFormat = "@"
 wks1.Columns("B").NumberFormat = "@"
 wks1.Columns("C").NumberFormat = "@"
 wks1.Columns("D").NumberFormat = "@"
 wks1.Columns("E").NumberFormat = "@"
 wks1.Columns("F").NumberFormat = "@"
 wks1.Columns("G").NumberFormat = "@"
 wks1.Columns("H").NumberFormat = "@"
 wks1.Columns("N").NumberFormat = "@"
 wks1.Columns("O").NumberFormat = "@"
 wks2.Columns("A").NumberFormat = "@"
 wks2.Columns("B").NumberFormat = "@"
 wks2.Columns("C").NumberFormat = "@"
 wks2.Columns("D").NumberFormat = "@"

 'clean up wks1
 wks1.Select
 Selection.ClearContents
 Selection.ClearFormats

 'get Value of DTPickers
 beginDate = LoadDialog.beginDate
 endDate = LoadDialog.endDate

 '***********SEARCH IN TEXTFILE**********
 '***************************************

 'Declaration
 Dim curPath$
 Dim xCount&
 Dim i&
 Dim Filename$
 Dim Titelline$
 Dim TokensTemp As Variant
 Dim compareToken
 Dim compareTokenV3x
 Dim compareTokenV40
 Dim compareTokenV41

 Dim Titleline

 Dim DataLine$
 Dim Tokens As Variant

 Dim TempOrigiNum
 Dim TempOrigiName
 Dim TempCalledNum
 Dim TempCalledName
 Dim TempDestNum
 Dim TempDestName
 Dim TempStartDate
 Dim TempStartTime
 Dim TempEndDate
 Dim TempEndTime
 Dim TempCurrency
 Dim TempCosts
 Dim TempState
 Dim TempPAP
 Dim TempLCR
 Dim TempProjNum
 Dim TempAOC
 Dim TempOrigiDevice
 Dim TempDestDevice

 Dim fs
 Dim myfile 'As Scripting.File
 Dim myfilestream 'As Scripting.TextStream

 Dim value, delta, flag, count, startminuten, stopminuten

 'get current pathname from textbox
 curPath$ = LoadDialog.curPath

 'Have to change the path
 Application.FileSearch.LookIn = curPath$
 Application.FileSearch.Filename = "*.txt"
 Application.FileSearch.FileType = msoFileTypeAllFiles

 Application.FileSearch.Execute

 'Number of files in the directory
 xCount& = Application.FileSearch.FoundFiles.count

 '#7
 'for each file
 For i = 1 To xCount&
 On Error GoTo 100

   Filename = Application.FileSearch.FoundFiles.Item(i)
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set myfile = fs.GetFile(Filename)
   Set myfilestream = myfile.OpenAsTextStream(1, -2)

   'ingore first line with titles
   Titleline = myfilestream.ReadLine
   TokensTemp = Split(Titleline, """")
   If InStr(Titleline, "IpPbxSrv") > 0 Then
       Titleline = myfilestream.ReadLine
       TokensTemp = Split(Titleline, """")
   End If

   If UBound(TokensTemp) > 0 Then

     compareToken = TokensTemp(1)
     compareTokenV40 = "OriginationNumber" 'version 4.0
     compareTokenV41 = "CallID" 'version 4.10

     '#8 Check if csv entry is for version 4.0
     If StrComp(compareToken, compareTokenV40, vbTextCompare) = 0 And
StrComp(compareTokenV3x, compareTokenV40, vbTextCompare) = 0 Then
       Do
           LoadDialog.MousePointer = fmMousePointerHourGlass
           'read line
           'this is the first data line
           DataLine = myfilestream.ReadLine
           Tokens = Split(DataLine, """")

           'take the tokens for each cell in the excelsheet
           TempOrigiNum = Tokens(1)
           TempOrigiName = Tokens(3)
...

read more