宏从txt文件中提取不正确的数据
宏从txt文件中提取不正确的数据
提问于 2019-09-14 13:37:34
宏从txt文件中提取不正确的数据。我有一个代码循环通过数百个文件，提取开始时间和诊断时间的时间戳，并将它们粘贴到A和B列中。开始时间的时间戳提取正确，但诊断的时间戳不正确。相反，txt文件中的第一行文本被拉出并粘贴到列B中。输入txt日志文件的示例如下所示，txt日志文件中还有数百个其他时间戳，但我关心的两个时间戳是start和irp诊断
+version=LogbookPlus 1.7.23
+site=
+lastedit=2019-08-31 17:19:31.289
+description=SRC - LSA-0251 error
+number=1282
+so=51657136
+toolowner=
+init=2019-08-30 08:40:38.360
+start=2019-08-30 08:25
+end=2019-08-30 09:45
+down=Unscheduled
+account=Source
+rooterror=LSA-0251
+subsystem=ILP-DC-PQ
+assy=Dose & power performance
+work=2019-08-30|08:39| [IRP] Diagnose
+work=2019-08-30|08:41| Start streaming
+work=2019-08-30|09:03| Conditioning
+work=2019-08-30|09:04| Standby以下是我的代码
Sub FindTimeStamps()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim MyFolder As String, MyFile As String
'Open Diaglouge box prompting user to choose folder path
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
'Create a new object for files in that folder and apply for/loop
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(MyFolder)
Dim fls As Object
Dim i As Integer
i = 1
For Each fls In objFolder.Files
'File Path of Text File
MyFile = MyFolder & "\" & fls.Name
'Determine the next file number available for use by the Fileopen function
TextFile = FreeFile
'open the text file
Debug.Print CurDir
Open MyFile For Input As #1
'Store file content inside a variable
Do Until EOF(1)
Line Input #1, textline
Text = Text & textline
Loop
Close #1
'Find Time Stamp Data from txt file
Dtime = Diagnose
Diagnose = InStr(1, Text, Dtime)
dt = Mid(Text, Diagnose + 1, 17)
Sttime = InStr(Text, "+start=")
'Paste obtained Time Stamp into excel Cells
Range("A" & i + 1).Value = Mid(Text, Sttime + 7, 16)
Range("B" & i + 1).Value = dt
i = i + 1
Text = ""
Next
End Sub如果我不对诊断变量进行硬编码，而是执行用户输入，例如
Find = InputBox("which word")
Open Text For Input As #1
Do While Not EOF(1)
Input #1, Text
If InStr(1, Text, Find) > 0 Then
idx = InStr(1, Text, "=")
dt = Mid(Text, idx + 1, 17)
Exit Do
End If
Loop这是由另一个用户建议的，代码工作并提取正确的时间戳。这样做的缺点是，我必须为文件夹中的每个文件输入诊断，这是不理想的。我还在学习VBA，所以我不仅在寻找解决方案，还在寻找硬编码变量不能正确提取数据的原因。谢谢您的帮助，非常感谢。
这是我在excel中得到的宏的输出，当我使用硬编码变量进行诊断时，在列b中没有用于诊断的时间戳它只是出于我不明白的原因提取输入txt文件的第一行
Column A Column B
8/28/2019 14:29 version=LogbookPl
8/29/2019 5:38 version=LogbookPl
8/30/2019 8:25 version=LogbookPl回答 2
Stack Overflow用户
回答已采纳
发布于 2019-09-15 12:12:29
试试这个：
Sub FindTimeStamps()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim MyFolder As String, MyFile As String
'Open Diaglouge box prompting user to choose folder path
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
'Create a new object for files in that folder and apply for/loop
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(MyFolder)
Dim fls As Object
Dim i As Integer
i = 1
For Each fls In objFolder.Files
'File Path of Text File
MyFile = MyFolder & "\" & fls.Name
'Determine the next file number available for use by the Fileopen function
TextFile = FreeFile
'open the text file
Debug.Print CurDir
Open MyFile For Input As #1
'Store file content inside a variable
Do Until EOF(1)
Input #1, textline
Text = textline
If (InStr(Text, "+start=") <> 0) Then
Sttime = InStr(Text, "+start=")
Range("A" & i + 1).Value2 = Mid(Text, Sttime + 7, 16)
i = i + 1
End If
If (InStr(Text, "| [IRP] Diagnose") <> 0) Then
dt = InStr(Text, "| [IRP] Diagnose")
Range("B" & i).Value2 = Mid(Text, dt - 16, 10) & " " & Mid(Text, dt - 5, 5)
End If
If (Range("B" & i).Value2 = "") And (Range("A" & i).Value2 <> "") Then _
Range("B" & i).Value2 = "No Diagnose"
Loop
Close #1
Next
End Sub有了你发给我的文件，它就能工作了。请查收
Stack Overflow用户
发布于 2019-09-14 15:44:12
试试这个吧。
我检查了几个文件中的一个，它就可以工作了。
Sub FindTimeStamps()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim MyFolder As String, MyFile As String
'Open Diaglouge box prompting user to choose folder path
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
'Create a new object for files in that folder and apply for/loop
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(MyFolder)
Dim fls As Object
Dim i As Integer
i = 1
For Each fls In objFolder.Files
'File Path of Text File
MyFile = MyFolder & "\" & fls.Name
'Determine the next file number available for use by the Fileopen function
TextFile = FreeFile
'open the text file
Debug.Print CurDir
Open MyFile For Input As #1
'Store file content inside a variable
Do Until EOF(1)
Input #1, textline
Text = textline
If (InStr(Text, "+start=") <> 0) Then
Sttime = InStr(Text, "+start=")
Range("A" & i + 1).Value = Mid(Text, Sttime + 7, 16)
End If
If (InStr(Text, "Diagnose") <> 0) Then
dt = InStr(Text, "Diagnose")
Range("B" & i + 1).Value = Mid(Text, dt - 24, 10) & " " & Mid(Text, dt - 13, 5)
i = i + 1
End If
Loop
Close #1
Next
End Sub希望能有所帮助
使用您提供的输入：(我只是重复一遍)
+version=LogbookPlus 1.7.23
+start=2019-08-30 08:25
+work=2019-08-30|08:41| [IRP] Diagnose
+work=2019-09-08|14:32| DAS power on
+work=2019-09-08|14:33| linux boot
+version=LogbookPlus 1.7.23
+start=2019-08-30 08:25
+work=2019-08-30|08:41| [IRP] Diagnose
+work=2019-09-08|14:32| DAS power on
+work=2019-09-08|14:33| linux boot
+version=LogbookPlus 1.7.23
+start=2019-08-30 08:25
+work=2019-08-30|08:41| [IRP] Diagnose
+work=2019-09-08|14:32| DAS power on
+work=2019-09-08|14:33| linux boot
+version=LogbookPlus 1.7.23
+start=2019-08-30 08:25
+work=2019-08-30|08:41| [IRP] Diagnose
+work=2019-09-08|14:32| DAS power on
+work=2019-09-08|14:33| linux boot我得到了：
这就是你要找的东西吗？
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/57932765
复制相关文章
相似问题
腾讯云开发者
