Sub csv_to_cdr()
'
' Ìàêðîñ1 Ìàêðîñ
' Ìàêðîñ çàïèñàí 24.10.2006 (Kraut)
'
'
With ActiveSheet
Dim in_file, out_file, v_startrow, v_sheetno, v_rows, v_cols, trunk_out, trunk_in, dat, dlit, flag, ved, wo_hour, tmp_i, z, nash_in, nash_out, x, fi, new_name, zu
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts, s, one, two, Atc
in_file = .Cells(2, 1)
out_file = .Cells(2, 2)
For j = 4 To 65000
If (.Cells(j, 2) <> "") Then
t_Atc(j - 3) = .Cells(j, 1)
t_out(j - 3) = .Cells(j, 2)
t_in(j - 3) = .Cells(j, 3)
t_nash(j - 3) = .Cells(j, 4)
t_zam(j - 3) = .Cells(j, 5)
End If
Next j
Dim filename, num_ch
Dim max_col
Set fs = CreateObject("Scripting.FileSystemObject")
Set fssearch = Application.FileSearch
With fssearch
.LookIn = in_file
.filename = "*.csv"
If .Execute > 0 Then
If (.FoundFiles.Count = 0) Then
MsgBox " ïàïî÷êå " & in_file & " ôàéëû csv íå íàéäåíû"
Exit Sub
End If
For i = 1 To .FoundFiles.Count
''Set fi = fs.GetFile(.FoundFiles(i))
new_name = Mid(.FoundFiles(i), 1, Len(.FoundFiles(i)) - 4)
fs.MoveFile .FoundFiles(i), new_name
v_csv = new_name
v_short_csv = v_csv
Position = InStr(1, v_short_csv, "\")
While (Position <> 0)
v_short_csv = Mid(v_short_csv, Position + 1)
Position = InStr(1, v_short_csv, "\")
Wend
v_short_csv = Trim(v_short_csv)
'wo_hour = Mid(v_short_csv, 1, Len(v_short_csv) - 5)
wo_hour = "384NVK-ATS71_" & _
Mid(v_short_csv, 8, 4) & _
Mid(v_short_csv, 13, 2) & _
Mid(v_short_csv, 16, 2) & _
"09_0002.CDR"
fs.CreateTextFile out_file & "\" & wo_hour 'Create a file
Set f = fs.GetFile(out_file & "\" & wo_hour)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
ts.Write ""
ts.Close
'fs = Nothing
Next i
End If
.filename = "*.*"
If .Execute > 0 Then
tmp_i = .FoundFiles.Count
For z = 1 To .FoundFiles.Count
i = tmp_i + 1 - z
v_csv = .FoundFiles(i)
v_short_csv = v_csv
Position = InStr(1, v_short_csv, "\")
While (Position <> 0)
v_short_csv = Mid(v_short_csv, Position + 1)
Position = InStr(1, v_short_csv, "\")
Wend
v_short_csv = Trim(v_short_csv)
' wo_hour = Mid(v_short_csv, 1, Len(v_short_csv) - 5)
wo_hour = "384NVK-ATS71_" & _
Mid(v_short_csv, 8, 4) & _
Mid(v_short_csv, 13, 2) & _
Mid(v_short_csv, 16, 2) & _
"09_0002.CDR"
' Open CSV
'----------------------------------
Workbooks.OpenText filename:=v_csv, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False
Windows(v_short_csv).Activate
' Windows(v_short_csv).Visible = False
With ActiveSheet
'fs.CreateTextFile out_file & "\" & wo_hour 'Create a file
Set f = fs.GetFile(out_file & "\" & wo_hour)
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)
For j = 3 To 65000
If .Cells(j, 1) = "" Then
col = j
Exit For
End If
Next j
For j = 3 To col
flag = False
one = ""
two = ""
For k = j + 1 To j + 50
If (.Cells(k, 1) = "4060") Then
zu = 1
End If
If ( _
(.Cells(j, 2) = .Cells(k, 2)) And _
(.Cells(j, 3) = .Cells(k, 3)) And _
(.Cells(j, 4) = .Cells(k, 4)) And _
(.Cells(j, 5) = .Cells(k, 5)) And _
(.Cells(j, 8) = .Cells(k, 8)) And _
(.Cells(j, 9) = .Cells(k, 9)) And _
(.Cells(j, 13) = .Cells(k, 13)) _
) Then
If (.Cells(k, 11) = "") Then
.Cells(k, 11) = .Cells(j, 11)
End If
If (.Cells(k, 12) = "") Then
.Cells(k, 12) = .Cells(j, 12)
End If
flag = True
Exit For
End If
Next k
If (flag = True) Then
flag = False
Else
If (.Cells(j, 1) <> "") And (.Cells(j, 6) = "") _
And (InStr(.Cells(j, 8), "*") = 0) And (InStr(.Cells(j, 9), "*") = 0) _
And (InStr(.Cells(j, 8), "#") = 0) And (InStr(.Cells(j, 9), "#") = 0) Then
' óñëîâèå íà òî ÷òî ýòî íàì íóæíî
one = .Cells(j, 8)
two = .Cells(j, 9)
trunk_out = .Cells(j, 11)
trunk_in = .Cells(j, 12)
dat = ""
dlit = ""
If (.Cells(j, 2) = "") Then
dat = dat & Format(.Cells(j, 4), "yyyyMMdd")
dat = dat & Format(.Cells(j, 5), "hhmmss")
Else
dat = dat & Format(.Cells(j, 2), "yyyyMMdd")
dat = dat & Format(.Cells(j, 3), "hhmmss")
End If
dlit = dlit & Second(.Cells(j, 13)) + Minute(.Cells(j, 13)) * 60 + Hour(.Cells(j, 13)) * 3600
nash_in = ""
nash_out = ""
If (trunk_in = "") Then
ved = in_ved(one)
If (ved <> 0) Then
trunk_in = t_in(ved)
nash_in = t_nash(ved)
End If
End If
If (trunk_out = "") And (Left(two, 1) <> "8") Then
ved = in_ved(two)
If (ved <> 0) Then
trunk_out = t_out(ved)
nash_out = t_nash(ved)
End If
End If
If ((trunk_in <> "") And ((nash_in = "N") Or (nash_in = ""))) Or ((trunk_out <> "") And ((nash_in = "N") Or (nash_in = ""))) Then
If Not ((Len(one) = 7) And (Mid(one, 1, 1) <> "3")) Then
ts.Write ",,,,,"
If (one <> "384") And (one <> "") Then ' åñëè '384' òî íè÷å íå ïèøåì
If (Len(one) = 7) And (Mid(one, 1, 1) = "3") Then
one = "73843" & Mid(one, 2)
Else
one = "7" + one ' ïðèïèñûâàåì ñåìåðêó
End If
Else
one = "" ' íè÷åãî
If (trunk_in <> "") Then
If (Left(trunk_in, 4) = "ATSE") Then
For x = 1 To col
If (Len(t_Atc(x)) = 2) Then
If (Mid(trunk_in, 5, 2) = t_Atc(x)) Then
one = t_zam(x)
Exit For
End If
End If
Next x
Else
For x = 1 To col
If (t_in(x) = trunk_in) Then
one = t_zam(x)
End If
Next x
End If
End If
End If
ts.Write one
ts.Write ","
If (Len(two) = 6) Then ' åñëè íîìåð 6 çíàêîâ òî ïðèïèñûâàåì '73843'
two = "73843" & two
Else
If (Len(two) = 10) Then ' åñëè íîìåð 10 çíàêîâ òî ïðèïèñûâàåì '7'
two = "7" & two
Else
If (Mid(two, 1, 5) = "82777") Then
two = "7384777"
Else
If (Mid(two, 1, 5) = "82779") Then
two = "7384779"
Else
If (Mid(two, 1, 2) = "82") Then
two = "7384" + Mid(two, 3)
Else
If (Len(two) >= 13) And (Mid(two, 1, 3) = "810") Then
two = Mid(two, 4)
Else
If (Len(two) >= 9) And (Mid(two, 1, 1) = "8") Then
two = "7" + Mid(two, 2)
End If
End If
End If
End If
End If
End If
End If
ts.Write two & ","
ts.Write dat & ","
ts.Write dlit & ","
ts.Write ",,,,,,,,,,,,,,,,,"
ts.Write "384"
ts.Write ",,,,"
ts.Write trunk_in
ts.Write ","
ts.Write trunk_out
ts.Write ",,,,,,"
ts.Write vbNewLine
End If
End If
End If
End If
Next j
ts.Close
End With
Windows(v_short_csv).Close False
'MsgBox .FoundFiles(i)
' new_name = Mid(.FoundFiles(i), 1, Len(.FoundFiles(i)) - 4)
fs.MoveFile .FoundFiles(i), .FoundFiles(i) & ".csv"
Next z
Else
MsgBox " ïàïî÷êå " & in_file & " ôàéëû csv íå íàéäåíû"
End If
End With
End With
MsgBox "Óñå!"
End Sub
Function in_ved(tel)
Dim i, j, co, tmp
If tel = "384" Then
in_ved = 0
Exit Function
End If
tmp = Right(tel, 6)
For i = 1 To 5
co = 7 - i
For j = 1 To col
If (Len(t_Atc(j)) = co) Then
If (Left(tmp, co) = t_Atc(j)) Then
in_ved = j
Exit Function
End If
End If
Next j
Next i
in_ved = 0
End Function
