LinkBack URL
About LinkBacksHi,
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
Register To Reply
Bookmarks