VB Script to seperate text into multiple files - text
I am trying to create a VBscript file that will seperate a text file into multiple text files. I haven't done any programming in a while and I have been banging my head with this for a few days.
This is part of the text file.
Tested on,8 May 2016,,,,
Asset ID,126567,,,,
Rigel 288,Z48-0366,,,,
Site,Workshop,,,,
Location,WORKSHOP,,,,
AP Setup,,0,,,
User Name,Workshop,,,,
Test Sequence,TestCode-BGC2,,,,
Live Voltage,,, 248,,,V
Neutral Voltage,,, 2,,,V
Load Current,,, 0.0,,,A
Load Test,,, 0.0,,,kVA
Enclosure Lkg,Mains Normal,, 8,Pass,100,µA
Enclosure Lkg,Mains Normal,SFC: Neutral Open, 12,Pass,500,µA
Enclosure Lkg,Mains Reversed,, 8,Pass,100,µA
Enclosure Lkg,Mains Reversed,SFC: Neutral Open, 12,Pass,500,µA
User Comment,,,,
Status,Pass
Tested on,8 May 2016,,,,
Asset ID,126563,,,,
Rigel 288,Z48-0366,,,,
Site,Workshop,,,,
Location,WORKSHOP,,,,
AP Setup,,0,,,
User Name,Workshop,,,,
Test Sequence,TestCode-BGC2,,,,
Live Voltage,,, 247,,,V
Neutral Voltage,,, 2,,,V
Load Current,,, 0.0,,,A
Load Test,,, 0.0,,,kVA
Enclosure Lkg,Mains Normal,, 8,Pass,100,µA
Enclosure Lkg,Mains Normal,SFC: Neutral Open, 12,Pass,500,µA
Enclosure Lkg,Mains Reversed,, 8,Pass,100,µA
Enclosure Lkg,Mains Reversed,SFC: Neutral Open, 13,Pass,500,µA
User Comment,,,,
Status,Pass
Tested on,8 May 2016,,,,
Asset ID,126555,,,,
Rigel 288,Z48-0366,,,,
Site,Workshop,,,,
Location,WORKSHOP,,,,
AP Setup,,0,,,
User Name,Workshop,,,,
Test Sequence,TestCode-BGC2,,,,
Live Voltage,,, 245,,,V
Neutral Voltage,,, 2,,,V
Load Current,,, 0.0,,,A
Load Test,,, 0.0,,,kVA
Enclosure Lkg,Mains Normal,, 8,Pass,100,µA
Enclosure Lkg,Mains Normal,SFC: Neutral Open, 12,Pass,500,µA
Enclosure Lkg,Mains Reversed,, 8,Pass,100,µA
Enclosure Lkg,Mains Reversed,SFC: Neutral Open, 12,Pass,500,µA
User Comment,,,,
Status,Pass
I need to be able to seperate each bit from start of string "Tested" and end of the string "Status,Pass" into seperate text files which need to be named after the specific asset ID e.g, "126567.txt"
If this could repeat until the end of file as there will be more than 3, usually around 40.
Any help would be really appreciated.
Give the below a try. I wrote it in VBA so let me know if you run into any issues. I think using Regular Expressions would be the quickest and easiest method to parse and pull out the values that you need. Let me know if you have any questions.
Const ForReading = 1
Dim objFSO, objFile, objRegEx
Dim objRegRes, strMatch, strID, strLine
Dim strFilePath, strOutFolder, strRead
'Path to your Main File
strFilePath = "C:\Path\ToFile\test.txt"
'Declare the File Scripting Object To Open, Create, and Read Text Files
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Check if File Exists
If Not objFSO.FileExists(strFilePath) Then
MsgBox "Cannot Find The File"
WScript.Quit
End If
'Create Regular Expression object to parse the file
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.MultiLine = True
'Capture all lines that starts with 'Tested' and ends with 'Status,Pass' _
'with a SubMatch or Capture Group for the Value between 'Asset ID,' and the next ','
objRegEx.Pattern = "^Tested on[\s\S]*?Asset ID\,(\S*?)\,[\s\S]*?Status\,Pass$"
'Save the Folder Path of the Main File to a Seperate Variable
strOutFolder = objFSO.GetParentFolderName(strFilePath) & Chr(92)
'Open and Read the Main File into a Variable
Set objFile = objFSO.OpenTextFile(strFilePath, ForReading, False)
strRead = objFile.ReadAll
objFile.Close
Set objFile = Nothing
'Execute the Regular Expression and Loop through the results
Set objRegRes = objRegEx.Execute(strRead)
For Each strMatch In objRegRes
strLine = Trim(strMatch)
strID = Trim(strMatch.SubMatches(0))
'Create Individual Text Files For Each Match - *Will OverWrite Files If They Exist
Set objFile = objFSO.CreateTextFile(strOutFolder & strID & ".txt", True)
objFile.Write strLine 'Change to: 'objFile.WriteLine' if you want an ending Carriage Return
objFile.Close
'Optional Cleanup
Set objFile = Nothing
strLine = vbNullString
strID = vbNullString
Next
MsgBox "Completed"
WScript.Quit
I copied the text of your post for my test and it appeared to work for me...
Related
Why after running Windows updates do I get "Run-Time Error 62 Input Past End of File"?
Any idea why I keep getting a Run -time error 62 Input past end of file error with the following code when using the Input function. The help function tells me the file is in binary and I should use either LOF or Seek however neither seems to work. This code worked fine until a recent Windows and Microsoft update to my computer. Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFilePicker) With fldr .Filters.Clear .Filters.Add "All files", "*.*" .Title = "Select a CFG File to Convert fromatting from R2013 to 1991." .AllowMultiSelect = False .InitialFileName = ActiveWorkbook.Path 'Application.DefaultFilePath If .Show <> -1 Then Exit Sub sItem = .SelectedItems(1) End With set fldr = Nothing Open sItem For Input As #1 dataArray = Split(Input(LOF(1), #1), vbLf) Close #1 If Len(dataArray(2)) - Len(Replace(dataArray(2), ",", "")) = 9 Then MsgBox "It appears the comtrade file format already conforms to the 1991 standard version." & vbNewLine & "" & vbNewLine & "Conversion was Aborted." Exit Sub End If I'm trying to count the number of commas in line 3 of the selected file.
dataArray = Split(Input(LOF(1), #1), vbLf)
That's a lot of work for a single line of code.
You're not validating the entire file, only the second line. You're also hard-coding a file handle#, and that can cause other problems - use the FreeFile function to get a free file handle from VBA instead of assuming #1 is available. Or better, use the higher-abstraction FileSystemObject instead (reference the Microsoft Scripting Runtime library):
With New Scripting.FileSystemObject
With .OpenTextFile(filename, ForReading)
Dim contents As String
contents = .ReadAll
End With
End With
Dim lines As Variant
lines = Split(contents, vbNewLine)
Or, without referencing the Scripting library:
Const ForReading As Long = 1
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(filename, ForReading)
Dim contents As String
contents = .ReadAll
End With
End With
Dim lines As Variant
lines = Split(contents, vbNewLine)
Note that when you code against Object, member calls are late-bound: you don't get IntelliSense/autocompletion, and you don't get any compile-time validation; typos will merrily compile (and blow up at run-time with error 438). Prefer early-bound code everywhere - I can't think of a reason to use late binding against the Scripting library though, since that library is the exact same on every Windows machine built this century.
VBA - Why opening Word from Excel is slow?
I wondered if anyone can shed some light on why opening a Word document would take a few seconds from Excel? The code below quickly finds/opens a specific subfolder using InStr i.e. debug.print of the subfolder name is immediate, however opening the specific Word doc takes about 4 seconds. I tried testing a similar procedure in Word itself it opened the document almost immediately. I'm still learning VBA and I'm not sure what the reason would be other than its something to do with the last bit re strFile
Any suggestions would be appreciated.
Sub LoopSubfolderAndFiles()
Dim fso As Object
Dim folder As Object
Dim subfolder1 As Object
Dim strTextFind1 As String
Dim strFileFound As String
Dim CurrFile As Object
Dim myFile As Object
Dim strFile As String
Dim strExtension As String
Dim wordApp As New Word.Application
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("Enter FILEPATH name..........")
Set subfolder1 = folder.subfolders
strTextFind1 = "useful"
strFileFound = "test"
strExtension = ".doc"
For Each subfolder1 In subfolder1
If InStr(1, subfolder1.Name, strTextFind1, vbTextCompare) > 0 Then
Set CurrFile = fso.GetFolder(subfolder1)
Debug.Print subfolder1.Name
Exit For
End If
Next
For Each CurrFile In CurrFile.Files
If InStr(1, CurrFile.Name, strFileFound, vbTextCompare) > 0 Then
Set myFile = fso.GetFile(CurrFile)
strFile = myFile.Path
wordApp.Visible = True
wordApp.Documents.Open (strFile)
Debug.Print strFile
End If
Next
Set fso = Nothing
Set folder = Nothing
Set subfolder1 = Nothing
Set CurrFile = Nothing
End Sub
There is nothing substantive wrong with your code. Word is slow. The difference could be inprocess vs outofprocess. Out of Process calls are made using the RPC networking remote call procedure. Hidden windows are created so messages can be received. It's all very complicated so out of process calls work under all circumstances. In Process Calls are just a machine code jump instruction. Several clock cycles vs tens of thousands or more. There are some minor issues. These lines are pointless. This is handled at the end of each line for implicit variables and every end function etc for explicit variables. See Declaring Variables Memory Leaks Set fso = Nothing Set folder = Nothing Set subfolder1 = Nothing Set CurrFile = Nothing If you want to do this indirection then they need to be const. The compiler will put them into the line where used as literals. Use variables only where needed. strTextFind1 = "useful" strFileFound = "test" strExtension = ".doc" So const strTextFind1 = "useful" const strFileFound = "test" const strExtension = ".doc" You are late binding to FSO. Use early binding as you do for Word. See Pointers needed for speeding up nested loop macro in VBA. Then instead of Dim folder As Object dim it as you do word.
Looking at your code, it's not just opening the document, it's also starting a new instance of the Word application*. So there are a number of factors that are taking time: Starting Word. Have you ever timed how long it takes Word to start when you click the icon? First, the application itself needs to load. Then, there may be any number of add-ins loading, which will take time. When an outside application "automates" another application there is a time "hit" for the "cross-barrier" communication. VBA within an Office application is usually quite fast; the same commands run from a different application will be (noticeably) slower. '* You should never declare and instantiate an application in the same line in VBA. You should change your code to: Dim wordApp as Word.Application Set wordApp = New Word.Application
VBS OpenTextFile returns unexpected result
This is my code:
Set fso = CreateObject("Scripting.FileSystemObject")
strText = fso.OpenTextFile(strLocalFolderName & "\" & Oudste).ReadAll()
msgbox strText
But strText contains rubbish after these lines.
How can that be?
Darn! The boolean option within OpenTextFile examples is often left out! fso.OpenTextFile(Path, ForReading, False, TriStateTrue) Path is the path to the file. ForReading should be 1 for read only. Then this False is the often omitted boolean (false means it's not written ) Only when the boolean is added correctly, you can pick a type of txt file. In my case unicode so I pick -1 for the Tristate. Tip: if you ever get weird results with textfiles, open in notepad, choose save as and then it will reveal what kind of text you actually have.
Your problem can be because a lot of thigs like the encode of target file, one of the most common encode us UTF-8 you can chage it with notepad++:
How do I convert an ANSI encoded file to UTF-8 with Notepad++?
I think you should put some validation code to find the real problem, I suggest this code:
ForReading=1 'Open a file for reading only. You can't write to this file.
ForWriting=2 'Open a file for writing.
ForAppending=8 'Open a file and write to the end of the file.
CreateIfNotExist=TRUE 'If you use FALSE you get error if not exist
set fso = CreateObject("Scripting.FileSystemObject")
if (fso.fileexists(".\test.txt")) then
set ts = fso.OpenTextFile(".\test.txt", ForReading, CreateIfNotExist)
if NOT ts.AtEndOfStream then
s = ts.ReadAll
msgbox s
else
msgbox "End of file"
end if
else
msgbox "File not found"
end if
Import file into microsoft access: field mapping
This is driving me insane. I've been banging my head against importing some excel data into microsoft access. Silly me for thinking that this should be easy since they are both microsoft products. There are three excel files of about 40MB each. Four tabs in each file, each tab has the same fields in the same order between the files. ie, tab A in file 1 has the same field names in the same order as tab A in file 2 and file 3. And the corresponding table in the access database as the exact same field names in the exact same order as in the files also. Same goes for the other tabs. There are about 90K rows and about 40 columns in each tab. The first tab I imported directly into Access and created a new table. Even though the other files have the same layout, I just can't seem to get access to import the other files correctly. Even though the fields have the exact same names in the exact same order, it keeps screwing up the mapping. Not grossly, I either get a type conversion error for a field or two (which I also don't get since all the fields in the access table are of type "short text" so i can just import whatever is in the data files with no processing) or a couple of the wrong source fields from the files get imported into the wrong target fields in the database. It's almost more annoying that just a few fields get messed up because it means I have to check the whole table to figure out if things went off. And it's not consistent, it screws up differently each time I try it. I tried importing the data from the excel files and also by saving each tab as a csv. Nothing works. WTF am I doing wrong. Happy to try using some other database (filemaker, etc). I don't care about using access, I just thought it would be easier but I don't get why this is so freaking difficult.
Import data from all worksheets in all files in a folder.
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As String
Dim strPassword As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
strPath = "C:\MyFolder\"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode
strFile = Dir(strPath & "*.xls")
intWorkbookCounter = 0
Do While strFile <> ""
intWorkbookCounter = intWorkbookCounter + 1
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPath & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPath & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPath & strFile
strFile = Dir()
Loop
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWkshtsFilesSepTbls
Using VBA in Excel 2010
We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file. EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*" EDIT The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function: Function OpenWorkbook(strPath As String) As Workbook On Error GoTo ErrorLabel Set OpenWorkbook = Workbooks.Open(strPath) ExitLabel: Exit Function ErrorLabel: If Err.Number = 1004 Then Resume ExitLabel Else 'other error handling code here Resume ExitLabel End If End Function Then you can consume the function like this: Dim w As Workbook Set w = OpenWorkbook(file.Path) If Not (w Is Nothing) Then '...
The problem you're having has to do with this line: If file.Type = "Microsoft Excel Worksheet" Then Try adding and replacing it with this: // add these lines just AFTER the line 'For Each file In files' IsXLFile = False FilePath = file.path FilePath2 = Right(FilePath, 5) FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1) If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True // replace faulty line with this line If IsXLFile = True Then Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not. Have a nice day.