[英]extract data from multiple text files in a folder into excel worksheet
I have multiple "datasheet" text files that are used with a program at work and need to harvest values from them and combine it all into a spreadsheet. 我有多个“数据表”文本文件与工作中的程序一起使用,并且需要从这些文本文件中获取值并将其全部合并到电子表格中。
The text files are formatted as such: 文本文件的格式如下:
[File]
DescText = "1756-IF16H 16 Channel Hart Analog Input Module";
CreateDate = 04-07-10;
CreateTime = 10:29;
Revision = 1.1;
HomeURL = "http://www.ab.com/networks/eds/XX/0001000A00A30100.eds";
[Device]
VendCode = 1;
VendName = "Allen-Bradley";
ProdType = 10;
ProdTypeStr = "Multi-Channel Analog I/O with HART";
ProdCode = 163;
MajRev = 1;
MinRev = 1;
ProdName = "1756-IF16H/A";
Catalog = "1756-IF16H/A";
Icon = "io_brown.ico";
The Tags are consistent through all the files and each lines ends with a semicolon [ ; 标签在所有文件中都是一致的,每行以分号[; ] so I'm assuming this should be pretty easy. ],所以我认为这应该很容易。 I need to pull "DescText","VendCode","ProdType","MajRev","MinRev",and"ProdName" into separate columns. 我需要将“ DescText”,“ VendCode”,“ ProdType”,“ MajRev”,“ MinRev”和“ ProdName”拉到单独的列中。
There are about 100 individual data files, each with a nonsensical filename, so I'm looking to have the macro just go through and open each one in the folder. 大约有100个单独的数据文件,每个文件的文件名都没有意义,因此我希望宏可以通过并打开文件夹中的每个文件。
Thanks for the help, here is the solution I came up with for this specific problem 感谢您的帮助,这是我针对此特定问题提出的解决方案
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "[directory of files]"
MyFile = Dir(MyFolder & "\*.txt")
Dim filename As String
Dim currentrow As Integer: currentrow = 2
Do While Myfile <> "" 'This will go through all files in the directory, "Dir() returns an empty string at the end of the list
'For i = 1 To 500 'this was my debug loop to only go through the first 500 files at first
filename = MyFolder & "\" & MyFile 'concatinates directory and filename
Open filename For Input As #1
Do Until EOF(1) 'reads the file Line by line
Line Input #1, textline
'Text = Text & textline
If textline = "" Then 'error handler, if line was empty, ignore
Else
Dim splitline() As String
splitline() = Split(textline, "=", -1, vbTextCompare)
'because of how my specific text was formatted, this splits the line into 2 strings. The Tag is in the first element, the data in the second
If IsError(splitline(0)) Then
splitline(0) = ""
End If
Select Case Trim(splitline(0)) 'removes whitespace
Case "DescText"
currentrow = currentrow + 1
'files that didn't have a description row, resulted in empty rows in the spreadsheet.
ActiveSheet.Range("A" & currentrow).Cells(1, 1).Value = splitline(1)
Case "Revision"
ActiveSheet.Range("B" & currentrow).Cells(1, 1).Value = splitline(1)
Case "ProdCode"
ActiveSheet.Range("C" & currentrow).Cells(1, 1).Value = splitline(1)
Case "ProdType"
ActiveSheet.Range("D" & currentrow).Cells(1, 1).Value = splitline(1)
'...etc. etc... so on for each "tag"
End Select
End If
Loop
Close #1
MyFile = Dir() 'reads filename of next file in directory
'currentrow = currentrow + 1
'Next i
Loop
End Sub
here how I would solve the complete task: 在这里,我将如何解决完整的任务:
Private Sub importFiles(ByVal pFolder As String)
' create FSO
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
' create folder
Dim oFolder As Object
Set oFolder = oFSO.getFolder(pFolder)
' go thru the folder
Dim oFile As Object
For Each oFile In oFolder.Files
' check if is a text file
If UCase(Right(oFile.Name, 4)) = ".TXT" Then
Debug.Print "process file: " & oFolder.Path & "\" & oFile.Name
readFile oFolder.Path & "\" & oFile.Name
End If
Next
' clean up
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Private Sub readFile(ByVal pFile As String)
' get new file handle
Dim hnd As Integer
hnd = FreeFile
' open file
Open pFile For Input As hnd
Dim sContent As String
Dim sLine As String
' read file
Do Until EOF(hnd)
Line Input #hnd, sLine
sContent = sContent & sLine
Loop
' close file
Close hnd
' extract requiered data
Debug.Print getValue(sContent, "ProdName")
Debug.Print getValue(sContent, "DescText")
End Sub
Private Function getValue(ByVal pContent As String, ByVal pValueName As String) As String
Dim sRet As String
sRet = ""
If InStr(pContent, pValueName) Then
pContent = Mid(pContent, InStr(pContent, pValueName) + Len(pValueName) + 2)
sRet = Left(pContent, InStr(pContent, ";") - 1)
sRet = Trim(sRet)
End If
getValue = sRet
End Function
Overall the solution contains 3 different procedures: 总体而言,该解决方案包含3个不同的过程:
importFiles reads the content of a given directory (which has to be handed over as parameter) and if it finds a .txt file it calls readFile() and passes the full path of the file to it importFiles读取给定目录的内容(必须将其作为参数传递),如果找到一个.txt文件,它将调用readFile()并将文件的完整路径传递给它
readFile() opens the text file and stores the content in a string variable. readFile()打开文本文件,并将内容存储在字符串变量中。 After this is done it calles getValue for each value you are interessted in. 完成此操作后,它将为您插入的每个值调用getValue。
getValue analyses the given content and extractes the given value. getValue分析给定的内容并提取给定的值。
Simply adjust the calls of getValue() so that you get all values you are interessted in and store them instead of showing via debug.print and call the first procedure with the right directory like importFiles "C:\\Temp" 只需调整getValue()的调用,即可获取所有您感兴趣的值并存储它们,而不是通过debug.print显示它,并使用正确的目录(如importFiles“ C:\\ Temp”)调用第一个过程
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.