I am getting this error while i am trying to read one by one all files in a dir, and also reading the text inside
An unhandled exception of type 'System.NullReferenceException' occurred in WindowsApplication1.exe
Additional information: Object reference not set to an instance of an object.
It is going good only for the first file , but when it starts another loop and gets the secound file from that folder there comes the problem.
This is my code
Dim theString As String
Dim path As String
Dim StrFile, str_5 As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim line As String
'theString = ""
path = "C:\IN\"
StrFile = Dir(path & "*.txt")
Do While StrFile <> ""
file = fso.OpenTextFile(path & StrFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, line.Substring(142, 1), vbTextCompare) = 5 Then
'Debug.Print(StrFile)
str_5 = str_5 & line
End If
Loop
file.Close()
file = Nothing
fso = Nothing
StrFile = Dir()
Loop
Just for other people with the same problem, the answer is to just remove this line
fso = Nothing
Related
Hi I am trying to open the latest file (date modified) in a folder. The code uses a loop to go through the files and find the latest modified which it does however when it comes to open the file using 'Workbooks.Open strFilename' it says the file (which it has already identified as the 'youngest' file could not be found. This doesn't make sense to me as the error message says the file 'test young' - the file name could not be found, but it clearly found it during the loop.
Sub copynewdata()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date
Dim Ref As Object, CheckRefEnabled%
CheckRefEnabled = 0
With ThisWorkbook
For Each Ref In .VBProject.References
If Ref.Name = "Scripting" Then
CheckRefEnabled = 1
Exit For
End If
Next Ref
If CheckRefEnabled = 0 Then
.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
End If
End With
'set path for files - change for your folder
Const myDir As String = "\\C:\Test"
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile
Workbooks.Open strFilename
'Set Source_Workbook = Workbooks(strFilename).Open(Target_Path)
Set FileSys = Nothing
Set myFolder = Nothing
End Sub
Can anyone help with this?
In strFilename, you have the name of the file - but without the path. Change the open-command to
Workbooks.Open myDir & "\" & strFilename
I am trying to get Excel to open any file in the a given folder
(ThisWorkbook.Path\Peach\Apple) that has .xlsm extension (there is always only 1 file). Is it possible to open it with wildcard character? I do not know the name of the file, just the extension.
If not, is there a way to do it?
Just ask the file system for the first matching file:
Dim path As String: path = ThisWorkbook.path & "\Peach\Apple\"
FindFirstFile = Dir$(path & "*.xlsm")
If (FindFirstFile <> "") Then
Workbooks.Open path & FindFirstFile
Else
'// not found
End If
(This will not search sub-directories)
You mentioned that it would be nice addition to open last modified file or file with shortest name, so let's start - there's a code example how you can grab all three files (first finded, last modified, with shortest name). You can modify this as you wish (add some parameters, add error handling, return only specified, etc).
Sub Test()
'declarations
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim path As String
Dim first_finded As Object
Dim recently_modified As Object
Dim shortest_name As Object
Dim recently As Date
Dim shortest As Long
Dim firstFinded As Boolean
'setting default recently date(24 hours from now) and path
recently = DateAdd("h", -24, Now)
path = ThisWorkbook.path & "\Peach\Apple\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
'iteration over folder
For Each file In folder.Files
If file.Name Like "*.xlsm" Then
'grab first finded .xlsm
If Not firstFinded Then
firstFinded = Not firstFinded
Set first_finded = file
End If
'grab lastmodified .xlsm
If file.DateLastModified > recently Then
recently = file.DateLastModified
Set recently_modified = file
End If
'grab short named .xlsm
If shortest = 0 Or shortest > Len(file.Name) Then
shortest = Len(file.Name)
Set shortest_name = file
End If
End If
Next
'debug-print names
Debug.Print first_finded.Name
Debug.Print recently_modified.Name
Debug.Print shortest_name.Name
'so now you can uncomment this and open what you want
'Call Workbooks.Open(path & recently_modified.Name)
End Sub
Try the code below, it will open your "*.xlsm" file, in the path you've requested.
Sub OpenXLSMWildcardfile()
Dim Path As String
Path = ThisWorkbook.Path & "\Peach\Apple\"
Workbooks.Open (Path & "*.xlsm")
End Sub
PFB for the code required for opening the macro file with extension(.xlsm).
Sub OpeningFile()
'Declaring variables
Dim FileName, FolderPath As String
'Initializing folder path
FolderPath = ThisWorkbook.Path & "\Peach\Apple\"
'Finding the file name using wildcard
FileName = Dir(FolderPath & "*.xlsm")
'Looping through the workbook which are saved as macro enabled workbooks
While FileName <> ""
Workbooks.Open FolderPath & FileName
FileName = Dir()
Wend
End Sub
I am trying to modify the following code, it will merge the Word Documents fine, but I have text file with every line being "*Name*.docx" "*Name2*.docx", etc, I would like the VBA macro to read the text file line by line and merge all the documents that match the pattern, should be 27 documents when done and save each one preferably with the a title that includes the "*Name" tag so I can know which is which. Any help would be greatly appreciated
Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Const strFolder = "C:\test\"
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*Name*.docx")
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
MsgBox ("Files are merged")
End Sub
I think it's just a matter of adding an extra loop that reads the input file line by line and then uses your loop above.
This example uses the scripting filesystemobject to open the file and read it.
I assume what you've said above is what you actually mean - and the file spec is in the text file. Change the constants to fit your needs
Sub MergeDocs()
Const FOLDER_START As String = "C:\test\" ' Location of inout word files and text file
Const FOLDER_OUTPUT As String = "C:\test\output\" ' send resulting word files here
Const TEST_FILE As String = "doc-list.txt"
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Dim strFileSpec As String
Dim strWordFile As String
Dim objFSO As Object ' FileSystemObject
Dim objTS As Object ' TextStream
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFile = FOLDER_START & TEST_FILE
If Not objFSO.FileExists(strFile) Then
MsgBox "File Doesn't Exist: " & strFile
Exit Sub
End If
Set objTS = objFSO.OpenTextFile(strFile, 1, False) 'The one was ForReading but for me it threw an error
While Not objTS.AtEndOfStream
Set MainDoc = Documents.Add
' Read file spec from each line in file
strFileSpec = objTS.ReadLine ' get file seacrh spec from input file
'strFileSpec = "*NAME2*"
strFile = Dir$(FOLDER_START & strFileSpec & ".docx") ' changed strFolder to FOLDER_START
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile FOLDER_START & strFile ' changed strFolder again
strFile = Dir$() ' Get next file in search
Loop
strWordFile = Replace(strFileSpec, "*", "") ' Remove wildcards for saving filename
strWordFile = FOLDER_OUTPUT & strWordFile & ".docx"
MainDoc.SaveAs2 strWordFile
MainDoc.Close False
Set MainDoc = Nothing
Wend
objTS.Close
Set objTS = Nothing
Set objFSO = Nothing
MsgBox "Files are merged"
End Sub
I need some help with a project in which I must open a list of text files, find a pattern in their contents and then move to other folders according to the pattern.
For example, in a list of text files, I must find which of them have the word "blue" written inside and them move only those to another folder named "Blue".
I was tring to do it using the command FileSystemObject, but I was kind of lost.
Thanks a lot in advance!!
Dim sDir As String
Dim sPath As String
Dim sPattern as String
Dim sReadedData as String
dim sDestiny as string
dim sPathDestiny as string
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
sPath$ = "c:\YourFolder"
sDir$ = Dir(sPath, vbDirectory)
sPattern= "abcdefg"
sDestiny="c:\DestinyFolder"
If sDir = "" Then
MsgBox "Path " & sDir & " Not Found"
End
End If
sDir$ = Dir(sPath & "\*.txt")
Do Until sDir = ""
sPathDestiny=Replace(sDir, sPath, sDestiny)
Open sDir$ For Input As #1
do until EOF(1)
Input #1, sReadedData
loop
if InStr(sReadedData, sPattern)>0 then
Call fso.CopyFile(sDir, sPathDestiny)
end if
Loop
This is the main idea. Play with it.
I am trying to rename a file from "X" to "XY" in the same folder. I have tried using File System Object and just the Name X as Y function, but neither is working. I do have the Microsoft Scripting Runtime reference installed. The code completes successfully but the file name does not change, Please advise.
Dim FSO As Object
Dim srcPath As String
Dim FromPath As String
Dim ToPath As String
Dim fldrName As String
srcPath = "C:\"
i = 1
Set FileSysObj_1 = New FileSystemObject
For Each Folder_Obj1 In FileSysObj_1.GetFolder(srcPath).SubFolders
i = i + 1
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
'If the file exists in the folder then rename it
If Dir(srcPath & Folder_Obj1.Name & "_Hotel.xlsx") Then
fldrName = Folder_Obj1.Name
FromPath = srcPath & fldrName & "_Hotel.xlsx"
ToPath = srcPath & "Hotel.xlsx"
'*** Neither of the following two lines work to rename the file
FSO.MoveFile FromPath, ToPath
Name FromPath As ToPath
Else
MsgBox "File doesn't exist."
End If
Next
Your question mentions that you're trying to rename a file in the same folder but, according to your code, you're actually moving it to the root of C:. You can use the following code as a replacement for what you have above. It will rename the file in its original folder.
Dim objFSO As New Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
For Each objFolder In objFSO.GetFolder("c:\").SubFolders
If objFSO.FileExists(objFolder.Path & "\_Hotel.xlsx") Then
' Rename...
objFSO.GetFile(objFolder.Path & "\_Hotel.xlsx").Name = "Hotel.xlsx"
End If
Next
Go to the tools menu in your VBA IDE and select references. Select "Microsoft Scripting Runtime".
Then declare
Dim FSO As FileSystemObject
Then the MoveFile should work.
Big Warning!
When using MoveFile for renaming a file it will only work with complete filenames without wildcards so
fso.MoveFile ( "somepath\myfile1.*" "somepath\myfile2" ) will error while
fso.MoveFile ( "somepath\myfile1.pdf" "somepath\myfile2.pdf" ) will work.
Wildcard in the first argument only works when really moving to a different location without changing the filename. Then the second argument should end with "\" Wonder why the documentation on MSDN is so cryptic.