Private Sub cmdImportSyslogs_Click()
Dim myDir As String, txt As String, x, y, i As Long, ii As Long
Dim m As Object, fn, SaveFol As String, ss
Dim a() As String, e, s, cr As String, n As Long, nn As Long, ff As Long, myList, temp()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1)
End With
If myDir = "" Then Exit Sub
myList = SearchFiles(myDir, 0, temp())
If IsError(myList) Then MsgBox "No file found": Exit Sub
SaveFol = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\dbTempzz"
If Dir(SaveFol, vbDirectory) = "" Then MkDir SaveFol
For i = 1 To UBound(myList, 2)
fn = Join(Array(myList(1, i), myList(2, i)), "\")
txt = CreateObject("Scripting.FilesystemObject").OpenTextFile(fn).ReadAll
For Each e In Array(vbCrLf, vbLf, vbCr)
If InStr(txt, e) Then cr = e: Exit For
Next
x = Split(txt, cr): n = 0
ReDim a(1 To UBound(x) + 1)
Dim p
For ii = 0 To UBound(x)
If x(ii) Like "[[]*" Then
x(ii) = Mid$(x(ii), 3)
x(ii) = Left$(x(ii), Len(x(ii)) - 2)
p = InStr(x(ii), " $ ")
ss = Replace(Mid$(x(ii), p + 3), " ", "^^^")
x(ii) = excel.Application.WorksheetFunction.Replace(x(ii), p, Len(x(ii)), "|" & ss & "|")
y = Split(x(ii), " ", 3)
y(1) = y(1) & "^^^" & y(2)
ReDim Preserve y(1)
n = n + 1: a(n) = Replace(Replace(excel.Application.WorksheetFunction.Trim(Join(y)), " ", "|"), "^^^", " ") & x(ii + 1)
End If
Next
If n > 0 Then
s = Right$(myList(2, i), 4)
ReDim Preserve a(1 To n)
ff = FreeFile
Open SaveFol & "\" & Replace(myList(2, i), s, ".txt") For Output As #ff
Print #ff, Join(a, vbCrLf);
Close #ff
End If
Next
ImportFiles SaveFol
End Sub
Function SearchFiles(myDir As String, n As Long, myList()) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not myFile.Name Like "~$*") * _
((LCase$(myFile.Name) Like "*.txt") + (LCase$(myFile.Name) Like "*.log")) Then
If FileLen(myDir & "\" & myFile.Name) Then
n = n + 1
ReDim Preserve myList(1 To 2, 1 To n)
myList(1, n) = myDir
myList(2, n) = myFile.Name
End If
End If
End Select
Next
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, n, myList)
Next
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function
Sub ImportFiles(myDir)
Dim fn As String, x, y, i As Long, ff As Long, flg As Boolean
Dim sql As String, s As String, ss As String, txt As String
fn = Dir(myDir & "\*.txt")
Do While fn <> ""
ss = "Tble_" & Left$(fn, InStrRev(fn, ".") - 1)
ff = FreeFile: flg = False
sql = "Create Table " & ss & " ("
Open myDir & "\" & fn For Input As ff
Do Until EOF(ff)
Line Input #ff, txt
If Not flg Then
y = Split(txt, "|")
For i = 0 To UBound(y)
s = s & IIf(s <> "", ", ", "") & "[Col_" & i + 1 & "] Char(80)"
Next
If TableExists(ss) Then DoCmd.DeleteObject acTable, ss
CurrentDb.Execute sql & s & ")"
flg = True
End If
s = "Insert Into " & ss & " Values('" & Replace(txt, "|", "','") & "')"
CurrentDb.Execute s: s = ""
Loop
Close #ff
fn = Dir
Loop
CreateObject("Scripting.FileSystemObject").DeleteFolder myDir
End Sub
Function TableExists(ByVal dbName As String) As Boolean
On Error Resume Next
TableExists = LenB(CurrentDb.TableDefs(dbName).Name)
End Function
Bookmarks