I am using Excel 2003 & I have following code in my macro.
Dim fs, a, retstring
Set fs = CreateObject("scripting.filesystemobject")
Set a = fs.OpenTextFile("C:\file.txt", ForReading, False)
Do While a.AtEndofStream <> True
retstring = a.ReadLine
Loop
a.Close
When I execute this, it shows
"Runtime Error:5"
Invalid Procedure Call or argument at OpenTextFile
You must define the constant ForReading first. And you may as well define the constants ForWriting and ForAppending while you're at it.
Dim fs, a, retstring
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile("C:\file.txt", ForReading, False)
Do While a.AtEndofStream <> True
retstring = a.readline
Loop
a.close
fso is considered slow. Here is a faster method to read a text file.
Sub Sample()
Dim MyData As String, strData() As String
Dim i as Long
'~~> Read the entire file in 1 go
Open "C:\MyFile.Txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
For i = LBound(strData) To UBound(strData)
Debug.Print strData(i)
Next
End Sub
It worked when i did like this.
Dim fs, a, retstring
Set fs = CreateObject("scripting.filesystemobject")
Set a = fs.OpenTextFile("C:\Users\228319\Desktop\file.txt", 1, False)
Do While a.AtEndofStream <> True
retstring = a.readline
Loop
a.Close
I am using Excel 2007 and got the same problem with near the same code snippet. Enabling 'Microsoft Scripting Runtime' should solve it (Main menu >Tools > References), it worked for me.
Related
I am using the following VBA function from Ryan Wells to find which user has an Excel open.
Function Excel_File_in_use_by(FilePath As String) As String
Dim strTempFile As String
Dim iPos As Integer, iRetVal As Integer
Dim objFSO As Object, objWMIService As Object, objFileSecuritySettings As Object, objSD As Object
iPos = InStrRev(FilePath, "\")
strTempFile = Left(FilePath, iPos - 1) & "\~$" & Mid(FilePath, iPos + 1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strTempFile) Then
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strTempFile & "'")
iRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If iRetVal = 0 Then
Excel_File_in_use_by = objSD.Owner.Name
Else
Excel_File_in_use_by = "unknown"
End If
Set objWMIService = Nothing
Set objFileSecuritySettings = Nothing
Set objSD = Nothing
Else
Excel_File_in_use_by = vbNullString
End If
Set objFSO = Nothing
End Function
The codes works great when I supply the file path and it begins with a mapped network drive, for example j:\Workbook.xlsx. But when the file path is passed in as a network address, for example \\server1\Workbook.xlsx I get runtime error '-2147217406 (80041002)'.
This was my test sub and the 2nd statement is giving me the runtime error
Sub test()
Debug.Print Excel_File_in_use_by("J:\Workbook.xlsx")
Debug.Print Excel_File_in_use_by("\\server1\Workbook.xlsx")
End Sub
Is it possible to use this code or amended it to be able to pass in file path in the network address as sometimes this is required as not all drives will be mapped.
I'm trying to import some data from tables in some word documents in excel using macros, but when it comes to open the word document and read it from an excel macro I can't do anything, because it says that I have no open document, but I do.
If I open a doc singularly calling it by its name it's alright, but the problem comes when I open files from a search and a loop.
Sub LoopFile()
Dim MyFile, MyPath As String
Dim wrdApp, wrdDoc
MyPath = "here goes my path with personal info, it points to a folder"
MyFile = Dir(MyPath)
Set wrdApp = CreateObject("Word.Application")
Do While MyFile <> ""
'parameters for the files to search
If MyFile Like "*.docx" And MyFile Like "All*" Then
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(MyPath & MyFile)
Call GetID
wrdApp.Close
End If
MyFile = Dir
Loop
End Sub
Sub GetId()
Dim cicli, y As Integer
'counter for iterations
cicli = cicli + 1
'if it's first iteration it starts from column E, otherwise the next one
If (cicli = 1) Then
y = 5
Else
y = y + 1
End If
ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range.Copy
ThisWorkbook.Worksheets("Foglio1").Cells(23, y).PasteSpecial xlPasteValues
End Sub
The problem comes when it arrives to
ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range.Copy
How can I fix it?
Thank you
Pass the document you are referring to and avoid the ActiveDocument. E.g., try to fix it in a way like this:
Set wrdDoc = wrdApp.Documents.Open(MyPath & MyFile)
GetID wrdDoc
And then change a bit the GetId Sub, accepting the wrdDoc parameter.
Sub GetId(wrdDoc as Object)
Dim cicli, y As Integer
'counter for iterations
cicli = cicli + 1
If (cicli = 1) Then
y = 5
Else
y = y + 1
End If
wrdDoc.Tables(1).Cell(Row:=1, Column:=2).Range.Copy
ThisWorkbook.Worksheets("Foglio1").Cells(23, y).PasteSpecial xlPasteValues
End Sub
How to avoid using Select in Excel VBA
I am trying to use FileSystemObject methods to find a specific line in a text file, and within that line replace a specific string. I am relatively new to this, as my current code has excel open the text file and replace what I need it to replace then save and close it. This way is no longer an option, as having excel open the text file takes too long and holds up the file.
This is how far I have gotten so far.
-
Sub FindLines()
Const ForReading = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = FSO.OpenTextFile("C:\Users\Carella Home\Desktop\boomboom.txt", ForReading, False)
Do Until objFSO.AtEndOfStream = True
go = objFSO.ReadLine
If InStr(1, go, "ant", vbTextCompare) > 0 Then
bo = Replace(go, "t", "wow")
End If
Loop
objFSO.Close
Set objFSO = FSO.OpenTextFile("C:\Users\Carella Home\Desktop\boomboom.txt", 2)
End Sub
-
The best I can do is open the file up to write, but I have no idea how to find the line and replace it with the line that I need to replace it with.
Please let me know if, in the event that you are willing to help/guide me in the correct direction, you need more information. I have searched a lot and have seen people suggest other ways of doing this. I need to learn how to edit lines this way. Can someone please help me?
Thanks in advance!
-Anthony C.
Not sure if this is the most efficient method but one idea would be to use the CreateTextFile method of the FileSystemObject, to create another file you can write to.
I've tested this on a small file and appears to be working as expected.
Modified after answer accepted to avoid .ReadLine and .WriteLine loops
Sub FindLines()
'Declare ALL of your variables :)
Const ForReading = 1 '
Const fileToRead As String = "C:\Users\david_zemens\Desktop\test.txt" ' the path of the file to read
Const fileToWrite As String = "C:\Users\david_zemens\Desktop\test_NEW.txt" ' the path of a new file
Dim FSO As Object
Dim readFile As Object 'the file you will READ
Dim writeFile As Object 'the file you will CREATE
Dim repLine As Variant 'the array of lines you will WRITE
Dim ln As Variant
Dim l As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set readFile = FSO.OpenTextFile(fileToRead, ForReading, False)
Set writeFile = FSO.CreateTextFile(fileToWrite, True, False)
'# Read entire file into an array & close it
repLine = Split(readFile.ReadAll, vbNewLine)
readFile.Close
'# iterate the array and do the replacement line by line
For Each ln In repLine
ln = IIf(InStr(1, ln, "ant", vbTextCompare) > 0, Replace(ln, "t", "wow"), ln)
repLine(l) = ln
l = l + 1
Next
'# Write to the array items to the file
writeFile.Write Join(repLine, vbNewLine)
writeFile.Close
'# clean up
Set readFile = Nothing
Set writeFile = Nothing
Set FSO = Nothing
End Sub
Then, depending on whether you want to get rid of the "original" file you could do something like:
'# clean up
Set readFile = Nothing
Set writeFile = Nothing
'# Get rid of the "old" file and replace/rename it with only the new one
Kill fileToRead
Name fileToWrite As fileToRead
End Sub
Here is a much faster and shorter method as compared to the FileSystemObject
Sub Sample()
Dim MyData As String, strData() As String
'~~> Read the file in one go!
Open "C:\Users\Carella Home\Desktop\boomboom.txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
End Sub
All your text file data is now in the array strData Simply loop though the array and find the text that you want to replace and write it back to the SAME file.
I want to delete the last line contain '*' of two notepad and apend the reamining data into a new notepad by excel macro.
Please guys help me out. I can't find any suggestion.
Using #mehow's suggestion, here is some code that you can use:
' To get this to run, you'll need to reference Microsoft Scripting Runtime:
' Per http://stackoverflow.com/questions/3233203/how-do-i-use-filesystemobject-in-vba
' Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \Windows\System32\scrrun.dll
' To reference this file, load the Visual Basic Editor (ALT-F11)
' Select Tools - References from the drop-down menu
' A listbox of available references will be displayed
' Tick the check-box next to 'Microsoft Scripting Runtime'
' The full name and path of the scrrun.dll file will be displayed below the listbox
' Click on the OK button
Sub appFiles()
'File path and names for each file
Dim sFile1 As String
Dim sFile2 As String
Dim sFileLast As String
'Search string
Dim sSearchStr As String
'Delimiter used to separate/join lines
Dim sDL As String
'If the final file already exists, should it overwrite the previous _
contents (True) or append to the end of the file (False)
Dim doOverwrite As Boolean
'File contents
Dim sMsg1 As String
Dim sMsg2 As String
Dim sMsgFinal As String
sFile1 = "C:\Users\foobar\Desktop\foo.txt"
sFile2 = "C:\Users\foobar\Desktop\foo2.txt"
sFileLast = "C:\Users\foobar\Desktop\fooFinal.txt"
sSearchStr = "*"
sDL = Chr(13) & Chr(10)
doOverwrite = True
sMsg1 = appendLines(sFile1, sSearchStr, sDL)
sMsg2 = appendLines(sFile2, sSearchStr, sDL)
sMsgFinal = sMsg1 & sDL & sMsg2
Call writeToFile(sMsgFinal, sFileLast, doOverwrite)
End Sub
Function appendLines(sFileName As String, sSearchStr As String, Optional sDL As String = " ") As String
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim oFS As TextStream
Dim sStr As String
Dim sMsg As String
If oFSO.fileexists(sFileName) Then 'Check if file exists
On Error GoTo Err
Set oFS = oFSO.openTextFile(sFileName)
'Read file
Do While Not oFS.AtEndOfStream
sStr = oFS.ReadLine
If InStr(sStr, sSearchStr) Then
appendLines = sMsg
Else
sMsg = sMsg & sStr & sDL
End If
Loop
oFS.Close
Else
Call MsgBox("The file path (" & sFileName & ") is invalid", vbCritical)
End If
Set oFS = Nothing
Set oFSO = Nothing
Exit Function
Err:
Call MsgBox("Error occurred while reading the file.", vbCritical)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
End Function
Sub writeToFile(sMsg As String, sFileName As String, Optional doOverwrite As Boolean = False)
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim oFS As TextStream
On Error GoTo Err
If oFSO.fileexists(sFileName) Then
If doOverwrite Then
Set oFS = oFSO.openTextFile(sFileName, ForWriting)
Else
Set oFS = oFSO.openTextFile(sFileName, ForAppending)
End If
Else
Set oFS = oFSO.CreateTextFile(sFileName, True)
End If
Call oFS.write(sMsg)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
Exit Sub
Err:
Call MsgBox("Error occurred while writing to the file.", vbCritical)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
End Sub
You'll need to customize the appFiles routine as needed, by providing file names to sFile1, sFile2, and sFileLast; your desired search string to sSearchStr (you mentioned using "*"); a delimiter to separate lines (it's currently written to use a carriage return and new line); and a parameter deciding whether or not to overwrite the final file (if you find yourself running this multiple times with the same final file).
Here's another link that I used while writing the code above: link - Explains how to write to a file from within a macro
Hope this helps.
Greetings, I'm hoping for help in figuring out how to store each row of a text file read into a VBA program as a string. I want to modify one of the strings and then put them all back together, but do not know how to read through a text file and store each row as a separate variable in an intelligent way. Thanks for any help you can provide!
If you don't want to add references, you could just go with straight vba code.
Take for instance the following file wordlist.txt:
realize
empty
theorize
line
socialize
here
analyze
The following code uses two methods to do as you described (one more common than the other):
Option Explicit
Sub main()
Dim sFileName As String
Dim sMergedLineArray() As String
Dim sTextToFind As String
Dim sReplacementText As String
Dim sOutputFile As String
Const MY_DELIMITER = "|"
sFileName = "C:\deleteme\wordlist.txt"
sMergedLineArray = ReadFileIntoArray(sFileName)
sTextToFind = "ze"
sReplacementText = "se"
'Loop through each value in the array and make a change if you need to
Dim x As Integer
For x = 0 To UBound(sMergedLineArray)
If InStr(1, sMergedLineArray(x), sTextToFind, vbTextCompare) > 0 Then
sMergedLineArray(x) = Replace(sMergedLineArray(x), sTextToFind, sReplacementText, 1, -1, vbTextCompare)
End If
Next x
sOutputFile = "C:\deleteme\UK_Version.txt"
If Not SpitFileOut(sOutputFile, sMergedLineArray) Then
MsgBox "It didn't work :("
End If
'OR...put it all together, make a mass change and split it back out (this seems unlikely, but throwing it in there anyway)
sTextToFind = "se"
sReplacementText = "ze"
Dim sBigString As String
Dim sNewArray As Variant
sBigString = Join(sMergedLineArray, MY_DELIMITER)
sBigString = Replace(sBigString, sTextToFind, sReplacementText, 1, -1, vbTextCompare)
sNewArray = Split(sBigString, MY_DELIMITER, -1, vbTextCompare)
sOutputFile = "C:\deleteme\American_Version.txt"
If Not SpitFileOut(sOutputFile, sNewArray) Then
MsgBox "It didn't work"
End If
MsgBox "Finished!"
End Sub
Function ReadFileIntoArray(sFileName As String) As String()
Dim sText As String
Dim sLocalArray() As String
Dim iFileNum As Integer
Dim iLineCount As Integer
iFileNum = FreeFile
Open sFileName For Input As #iFileNum
Do Until EOF(iFileNum)
Input #iFileNum, sText
ReDim Preserve sLocalArray(iLineCount)
sLocalArray(iLineCount) = sText
iLineCount = iLineCount + 1
Loop
Close #iFileNum
ReadFileIntoArray = sLocalArray
End Function
Function SpitFileOut(sFileName As String, sMyArray As Variant) As Boolean
Dim iFileNum As Integer
Dim iCounter As Integer
SpitFileOut = False
iFileNum = FreeFile
Open sFileName For Output As #iFileNum
For iCounter = 0 To UBound(sMyArray)
Print #iFileNum, sMyArray(iCounter)
Next
Close #iFileNum
SpitFileOut = True
End Function
If you run the main sub, you'll end up with two files:
UK_Version.txt: This is the result of the first method
American_Version.txt: This is the result of the second
There's lesson 1 of VBA, young Padawan; absorb it, learn and change your login name :P
Look into the FileSystemObject (ref: 1, 2, 3)
You have to go to <Tools/References> menu and include the Microsoft Scripting Runtime and create a global variable Global fso as New FileSystemObject. Now anywhere in your code do things like fso.OpenTextFile() which returns a TextStream. Each TextStream has methods loke ReadLine(), ReadAll(), SkipLine(), WriteLine(), etc ...
Here is a quick sample code.
Global fso as New FileSystemObject
Sub TEST()
Dim ts As TextStream
Set ts = fso.OpenTextFile("text_file.txt", ForReading, False)
Dim s As String
s = ts.ReadAll()
End Sub