无法合并不同的日志文件

时间:2018-11-26 06:40:28

标签: excel vba

enter image description here出现运行时错误1004。

摘要:-我需要将所有位于永久位置的不同系统生成的日志文件复制到位于相同或任意随机位置的一个工作簿。 这些日志是从客户端服务器复制的,并且以无格式方式包含数千行数据。 该数据每天刷新。它以.log文件的形式出现。

文件名为ms.log,ms.log.1,ms.log.2,依此类推。enter image description here

我的代码在一段时间内运行良好。但是由于几天后出现一个错误,提示“运行时错误1004”。错误显示“无法打开文件,因为在第2行的位置620处应使用分号。”

附带错误屏幕截图。

错误调试器标记为黄色的代码行:

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))

该错误仅出现在一个日志文件中。如果我跳过该文件,则没有错误。如果我手动打开并复制该文件的内容,则没有错误。

Sub CopyAllData()

Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim i As Long
path1 = "C:\Users\BhatiaP\Desktop\Project\"

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
    xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.log*")
If xFile = "" Then
    MsgBox "No files found"
    Exit Sub
End If
Do While xFile <> ""
    xFiles.Add xFile, xFile
    xFile = Dir()
Loop
Set xToBook = Workbooks.Open(path1 & "Master.xlsm")
If xFiles.Count > 0 Then
    For i = 1 To xFiles.Count
        'On Error Resume Next
        Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
        xWb.Worksheets(1).copy After:=xToBook.Sheets(xToBook.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = xWb.Name
        On Error GoTo 0
        xWb.Close False
    Next
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

1 个答案:

答案 0 :(得分:0)

代码正在打开每个文件并按原样复制数据。我试图逐行复制数据,并且有效。