I've been wracking my brains with a file input problem, I've finally got it down to two problems, I can get past the error 62, "Read past End of file", but this one I can't get past.
Can someone tell me if I'm doing anything wrong / verify?
Basically the (this) code writes two lines#
?xml version="1.0"?
A Second Line
the debug statement in Part 1 (write file) prints the text as
?xml version="1.0"?
A Second Line
the debug statement in Part 2 (read file) prints the text as
ÿþ?xml version="1.0"?
A Second Line
As you can see, there are two extra characters being added to the either the input or
the output stream at the beginning of the file.
A second line has been added for completeness to show in more detail that it is only the first line that is being screwed.
When I look through Notepad there is nothing extra, what/where are these extras coming from?
Any thoughts, thanks in advance,
regards
Seán
Sub writeXMLTest()
'Part 1 - Write the file
Dim FSO As Object
Dim NewFile As Object
Dim FullPath As String
Dim XMLFileText As String
FullPath = "E:\TESTFILE.xml"
'On Error GoTo Err:
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFile = FSO.CreateTextFile(FullPath, 1, 1)
XMLFileText = ""
XMLFileText = XMLFileText & "?xml version=" & Chr(34) & "1.0" & Chr(34) & "?" & vbNewLine
NewFile.Write (XMLFileText)
Debug.Print XMLFileText
XMLFileText = XMLFileText & "A Second Line" & vbNewLine
NewFile.Write (XMLFileText)
Debug.Print XMLFileText
NewFile.Close
'Part 1 - Complete
'Part 2 - Now to read the file
Dim FileNum As Integer, i As Integer
Dim s As String
' fpath = Application.GetOpenFilename
FileNum = FreeFile()
Open FullPath For Input As #FileNum
i = 1
While Not EOF(FileNum)
Line Input #FileNum, s ' read in data 1 line at a time
Debug.Print s
Wend
End Sub
Just a quick shot: Generally, xml-files use UTF8 encoding. But the FileSystemObject cannot handle UTF8. You can do this (read and write UTF8-Files in VBA) with an ADODB.Stream object - you'll find examples across the web.
Related
How do I open a text file and look for a specific string?
I want that the string "productactivated=true" determines whether to display a message on the Userform telling the user to activate.
A few days ago I asked for help with opening a text file and doing some reading and writing, so I came up with this
Open "application.txt" For Output As #1
ClngLine = lngLine + 1
Line Input #f, strLine
If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
MsgBox "Search string found in line " & lngLine, vbInformation
blnFound = True
Close #1
For your solution two files will be used showing how to read and write to text files. The writing was added just to show you how to do it but does not seem to be needed for your solution per your question statement. For this solution purpose, all the files are in the same folder.
The first file is the file being read from. For the demo purpose, since not data was supplied it was created with the following data and named "TextFile.txt":
This is the first line.
This is the second line and has productactivated=true.
Third line lays here.
productactivated=true is found in line four.
The second file is the file being written to. For the demo purpose just to show how it is done, but per your question isn't needed, and named "TextFile.txt":
This is the first line.
This is the second line and has productactivated=true.
Third line lays here.
productactivated=true is found in line four.
The VBA code:
Sub search_file()
Const ForReading = 1, ForWriting = 2
Dim FSO, FileIn, FileOut, strSearch, strTmp
'FileSystemObject also called as FSO, provides an easy object based model to access computer’s file system.
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set FileIn to the file for reading the text into the program.
Set FileIn = FSO.OpenTextFile("TextFile.txt", ForReading)
'Set FileOut to the file for writing the text out from the program.
'This was added just to show "how to" write to a file.
Set FileOut = FSO.OpenTextFile("TextFileRecordsFound.txt", ForWriting, True)
'Set the variable to the string of text you are looking for in the file you are reading into the program.
strSearch = "productactivated=true"
'Do this code until you reach the end of the file.
Do Until FileIn.AtEndOfStream
'Store the current line of text to search to work with into the variable.
strTmp = FileIn.ReadLine
'Determines whether to display a message
'(Find out if the search text is in the line of text read in from the file.)
If InStr(1, strTmp, strSearch, vbTextCompare) > 0 Then
'Display a message telling the user to activate.
MsgBox strSearch & " was found in the line:" & vbNewLine & vbNewLine & strTmp, , "Activate"
'Write the line of text to an external file, just to demo how to.
FileOut.WriteLine strTmp
End If
Loop 'Repeat code inside Do Loop.
'Close files.
FileIn.Close
FileOut.Close
End Sub
Everything is working for me in sending an email with an attachment from Excel using Visual Basic via Thunderbird when the attachment path is hard-coded.
attachment=C:\Users\Desktop2017\Desktop\customer\customerNumber\invoiceNumber.pdf"
But I need to change part of the file path for attachment based on what's in cell M4 and have the file name change based on what's in cell J4.
Example: M4 value is currently 101. J4 value is currently 2000-01. The output should be "C:\Users\Desktop2017\Desktop\customer\101\2000-01.pdf"
I have tried using 'Range' to get the value and setting a string but instead of getting the data from the cell or string it just outputs whatever I have after the equals sign.
I've tried adding and moving quotation marks around but nothing has worked at this point.
Thanks in advance for any help, Dalton.
PS: Sorry for hobbled together code.
Private Sub EmailInvoice_Click()
Dim FileNumber As Integer
Dim retVal As Variant
Dim strName As String
Dim strFile As String
Dim wsCustomer As Worksheet
strName = Range("Q2").Value
strFile = Dir(strFolder & "*.xlsx")
Const MY_FILENAME = "C:\Users\Desktop2017\Dropbox\temp\invoice.BAT"
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "cd ""C:\Program Files (x86)\Mozilla Thunderbird"""
Print #FileNumber, "thunderbird -compose"; _
" to=" + ThisWorkbook.Sheets("hourlyInvoice01").Range("N21") _
+ ",subject=Invoice " + ThisWorkbook.Sheets("hourlyInvoice01").Range("J4") + ",format="; 1; _
",body=""<HTML><BODY>Hello "; ThisWorkbook.Sheets("hourlyInvoice01").Range("N20") _
+ ",<BR><BR>Please see attached.<BR><BR>Thanks, Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=C:\Users\Desktop2017\Desktop\test\script\someFile.txt"
Print #FileNumber, "exit"
Close #FileNumber
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
'Kill MY_FILENAME
End Sub
Add this before that line
Dim FlName As String
FlName = "C:\Users\Desktop2017\Desktop\customer\" & Range("M4").Value & "\" & Range("J4").Value & ".pdf"
and then change the line
",<BR><BR>Please see attached.<BR><BR>Thanks, Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=C:\Users\Desktop2017\Desktop\test\script\someFile.txt"
to
",<BR><BR>Please see attached.<BR><BR>Thanks, Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=" & FlName
Note: To concatenate strings, use & instead of +
I am a technical writer and not much of a coder, I have thousands of .xml files that combined create a book. I used a VBA script from this website to rename all of the files to fit within the new guidelines, now I need to go into the xml code and find all references to those links and replace them with the new file name.
I have an excel spreadsheet where in column A it has the old file name and in column B it has the new file name.
The tag looks like this:
<?iads.link docref="R381"?>
It needs to find "R381" in column A and replace it with "R01081-1-1520-237", the file name in the adjacent cell in column B.
The Tag needs to look like this:
<?iads.link docref="R01081-1-1520-237"?>
I tried using the code from the question How can I Find/Replace multiple strings in an xml file? but it did not work and I'm not even sure if that's the correct question to be asking
My current code looks lie this:
Option Explicit ' Use this !
Public Sub ReplaceXML(rFindReplaceRange As Range) ' Pass in the find-replace range
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Dim i As Long
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3"
iFileNum = FreeFile
Open sFileName For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
' Loop over the replacements
For i = 1 To rFindReplaceRange.Rows.Count
If rFindReplaceRange.Cells(i, 1) <> "" Then
sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
End If
Next i
' Save file
iFileNum = FreeFile
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3"
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End Sub
Sub mike1()
End Sub
You are passing the file path when in fact you should be passing the fully qualified file name (file path and file name).
You need to edit those lines
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3"
'...
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3"
With
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3\yourfilename.xml"
'...
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3\yourNEWfilename.xml"
Also, remember to provide the correct Range when running the procedure.
Supposing your Range goes from "A1:B50" you can edit your mike1 sub as follows:
Sub mike1()
' Change range as desired
Call ReplaceXML(ThisWorkbook.Worksheets("YourSheetName").Range("A1:B50"))
End Sub
After that, all you need to do is run mike1 from the Immediate window.
Access using Alt+F11 for the VBA editor then View -> Immediate.
You should see a new window at the bottom of the screen. Just type mike1 in there and hit Enter
UPDATE:
Ideally, you should first try to understand the code you currently have and change it make it work on multiple files instead of a single one per run. There are many places around that can give you examples on how to do that, either recursively or in a loop directly into a function. There are many ways to do it and also many material around it.
That being said, you can find below one of the many approaches to solve your issue. The following code consists of two Subs that you can copy/paste into your module.
You need to change the value of HOST_PATH with the main folder and the findReplaceRange with the range to work with. You need to change "Sheet1" with the name of your worksheet and the "A1:B10" with your actual range. After that, just run the ReplaceXML2() Sub.
Note: this will update ALL XML files under the folder provided, so make sure you gave it enough testing (preferably, backup your files) before running it for the entire folder. If you have further issues I suggest asking another question.
Code:
Public Sub ReplaceXML2()
Const HOST_PATH = "C:\Users\s37739\Desktop\chap3\" ' change accordingly
Dim findReplaceRange As Range
Set findReplaceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10") ' change accordingly
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Call RecursivelyReplaceXML(FileSystem.GetFolder(HOST_PATH), findReplaceRange)
End Sub
Public Sub RecursivelyReplaceXML(parentFolder, rFindReplaceRange As Range) ' Pass in the folder and the find-replace range
Dim subFolder As Object
For Each subFolder In parentFolder.SubFolders
RecursivelyReplaceXML subFolder, rFindReplaceRange
Next
Dim file As Object
For Each file In parentFolder.Files
If Right(file.Name, 4) = ".xml" Then
Dim iFileNum As Integer
Dim sTemp As String
Dim sBuf As String
Dim i As Long
Dim fullFileName As String
fullFileName = file.Path
iFileNum = FreeFile
Open fullFileName For Input As iFileNum
sTemp = "" ' clean up to read the next file
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
' Loop over the replacements
For i = 1 To rFindReplaceRange.Rows.count
If rFindReplaceRange.Cells(i, 1) <> "" Then
sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
End If
Next i
' Save file
iFileNum = FreeFile
' WARNING: New name definition commented out,
' which means all files will be replaced with newer versions!!
'===
' Alter fullFileName first to save to a different file e.g.
' fullFileName = "C:\Users\s37739\Desktop\chap3\"
Open fullFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End If
Next
End Sub
I have the following code where I am trying to modify some Txt files in a specific folder. I first want to check that the Loop works. However when I run the macro the code can only read the first file and then there is a runtime 5 error at strFileName = Dir(). I am not sure what the problem is. The only issue I can think of is that I am moving the code between two module sheets. The folder location is being saved in a txt box in Sheet 1 of an excel workbook.
Sub Txt_File_Loop()
Public TextFile As String
Dim FolderLocation As String
Dim strFielName As String
Dim SaveLocation As String
'Location is present in a Text box
FolderLocation = Sheets(1).FolderLocationTXTBX.Text
strFileName = Dir(FolderLocation & " \ * ")
Do Until strFileName = ""
TextFile = FolderLocation & "\" & strFileName
Module2.Macro1
strFileName = Dir() 'ERROR is Here
Loop
End Sub
Sub Macro1()
Dim x As String
Open TextFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
x = x & textline
Loop
Close #1
MsgBox x
End Sub
Have a look at these modifications. They seem to correct several things and run through well.
Option Explicit
Sub Txt_File_Loop()
Dim FolderLocation As String
Dim strFileName As String
Dim SaveLocation As String
'Location is present in a Text box
FolderLocation = Sheets(1).FolderLocationTXTBX.Text 'Environ("TMP")
strFileName = Dir(FolderLocation & "\*.txt")
Do Until strFileName = ""
Debug.Print FolderLocation & "\" & strFileName
Module2.Macro1 FolderLocation & "\" & strFileName
strFileName = Dir() 'ERROR is Here
Loop
End Sub
Sub Macro1(sFPFN As String)
Dim x As String, textline As String
Debug.Print sFPFN
Open sFPFN For Input As #1
Do Until EOF(1)
Line Input #1, textline
x = x & textline
Loop
Close #1
MsgBox x
End Sub
I passed the folder and filename name across as a string-type parameter. Also, I don't know why you had the extra spaces in (FolderLocation & " \ * " ; I tightened that up. There were a few misspellings and undeclared variables; these can be avoided with Option Explicit¹ at the top of the module code sheet. Get into the practise of standard indentation with your code. It certainly improves readability if nothing else.
¹ Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.
In VB6, I'm looking for a way to remove a line of text from a text file if that line contains some string. I work mostly with C# and I'm at a loss here. With .NET there are several ways to do this, but I'm the lucky one who has to maintain some old VB code.
Is there a way to do this?
Thanks
Assuming you have the filename in a variable sFileName:
Dim iFile as Integer
Dim sLine as String, sNewText as string
iFile = FreeFile
Open sFileName For Input As #iFile
Do While Not EOF(iFile)
Line Input #iFile, sLine
If sLine Like "*foo*" Then
' skip the line
Else
sNewText = sNewText & sLine & vbCrLf
End If
Loop
Close
iFile = FreeFile
Open sFileName For Output As #iFile
Print #iFile, sNewText
Close
You may want to output to a different file instead of overwriting the source file, but hopefully this gets you closer.
Well text files are a complicated beast from some point of view: you cannot remove a line and move the further text backward, it is a stream.
I suggest you instead about considering an input to output approach:
1) you open the input file as text
2) you open a second file for output, a temporary file.
3) you iterate through all lines in file A.
4) if current line contains our string, don't write it. If current line does not
contains our string, we write it in the file B.
5) you close file A, you close file B.
Now you can add some steps.
6) Delete file A
7) Move file B in previous file A location.
DeleteLine "C:\file.txt", "John Doe", 0,
Function DeleteLine(strFile, strKey, LineNumber, CheckCase)
'Use strFile = "c:\file.txt" (Full path to text file)
'Use strKey = "John Doe" (Lines containing this text string to be deleted)
Const ForReading = 1
Const ForWriting = 2
Dim objFSO, objFile, Count, strLine, strLineCase, strNewFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
If CheckCase = 0 Then strLineCase = UCase(strLine): strKey = UCase(strKey)
If LineNumber = objFile.Line - 1 Or LineNumber = 0 Then
If InStr(strLine, strKey) Or InStr(strLineCase, strKey) Or strKey = "" Then
strNewFile = strNewFile
Else
strNewFile = strNewFile & strLine & vbCrLf
End If
Else
strNewFile = strNewFile & strLine & vbCrLf
End If
Loop
objFile.Close
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForWriting)
objFile.Write strNewFile
objFile.Close
End Function