I'm using Dir function to get directory's content right now.
FileSpec = DirPath & "/GenerateID_*_*.zip"
FileName = Dir(FileSpec)
But Dir function is locking the folder and can't delete that folder until I close my VBA application. I have tried ChDir("C:\") to make this point to another directory after calling Dir function but it's not working.
Is it possible to filter using FileSystemObject like Dir function? Or get all files with FileSystemObject, loop each fileName and checking each one would be the only option?
You can certainly loop through the files with the FileSystemObject. From the MSDN documentation for the Files Property of the FileSystemObject:
Function ShowFileList(folderspec)
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
s = s & f1.name
s = s & "<BR>"
Next
ShowFileList = s
End Function
This will return a string that is delimited by '<BR>'. You can replace this with something else, like vbCrLf or whatever you like then parse the string as required.
Related
It seems like I just cant add a copied Part two a productDoc. Its possible to paste it directly into the ProductDocument, but than I cant save it. What I need to do is:
Create ProductDoc
Create a ProductDoc in rootProductDoc
Copy Part from another Doc
Paste Part in ProductDoc from second step
Anyone an idea how to do that?
Im using CATIA V5-6 Release 2016, ServicePack 5 Build Number 26
There just dont seem any functions to select the ProductDoc from step 2.
I figured it out, thanks downvoters.
You cannot add a PartDocument itself to a Product, it needs to be a ProductDocument to which a Part is added (with AddNewComponent("Part","")).
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim productDoc As ProductDocument
Set productDoc = documents1.Add("Product")
Dim rootProduct As Product
Set rootProduct = productDoc.Product
Dim childProduct As Product
Set childProduct = rootProduct.Products.AddNewComponent("Product", "")
Dim part1 As Product
Set part1 = childProduct.Products.AddNewComponent("Part", "")
Dim part2 As Product
Set part2 = childProduct.Products.AddNewComponent("Part", "")
MaxVR, thanks for coming back and posting the solution! It was really helpful for the product symmetry macro I'm working on. There's another way to insert parts into a CATProduct if the parts already exist.
'These three lines are variants
'products_variant_file_open represents the product that we want our part to be added to
'variant_array_file_open is where we store our file path
Dim products_variant_file_open
Set products_variant_file_open = current_rh_product.Products
Dim variant_array_file_open(0)
variant_array_file_open(0) = root_file_location & "\" & current_product.PartNumber & "_RH.CATPart"
'Below is the command that inserts the CATPart. The left thing to specify is the array that holds
'the file name and the right thing is the type of file to add
Here's some sample code that shows how I got my file path to insert parts from
'prod_doc.Path gets path of the product document and the stuff to the right becomes the folder name
root_file_location = prod_doc.Path & "\" & name_prod.Name & "_RH_Parts"
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'Creates a folder in specified path with the specified name
fso.CreateFolder (root_file_location)
Then I used a function to loop through the folder and search for specific names
Function rh_folder_lookup(rh_part_file_name As String,
root_file_location_func As String)
'Default rh folder lookup to be false when it's false we can't find a matching file in our folder so we make a new rh part
rh_folder_lookup = False
'Set the file name to all the files in our folder
Dim fileName As Variant
fileName = Dir(root_file_location_func & "\") 'The slash at the ends makes the directory all the files in the folder instead of just that folder
'Loop through all files in a folder
While fileName <> ""
If fileName = rh_part_file_name & ".CATPart" Or fileName = rh_part_file_name Then
'MsgBox fileName & "!!!"
rh_folder_lookup = True
Exit Function
End If
fileName = Dir 'Set the fileName to the next file
Wend 'Wend means end when the condition is true
End Function
I have a folder contain texts files . The text is presented as below :
NAME Number Mail Date
xx 1 zz //
and I want to write a vba code that read all the text files and search for an information "NAME" to replace it with "name"and then save the modifications .
I did the code below , but I have an error 70 permission denied in Set f = FSO.OpenTextFile(Fichier, forWriting, True) ,
could you help me ?
Sub Sample()
dim fso=createobject("scripting.filesystemObject")
dim f
dim path as string
dim file_txt as string
path= "C:\Users\Folder\Fileshere\"
file_txt= Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = FSO.OpenTextFile(file_txt, ForReading)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange , "NAME", "name")
Set f = FSO.OpenTextFile(file_txt, forWriting, True)
f.Write Namechange
file_txt=dir()
loop
end sub
I'd rewrite using a bit more of the FileSystemObject functionality rather than using Dir() personally, but that's open to your own choice. The key issue I think you are having is that you have opened the file for reading and then immediately tried to open it for writing while the TextStream object is still in memory, and locking the file. This is why you are getting "Permission denied". To quote from a TechNet Article:
Opening Text Files
Working with text files is a three-step process.
Before you can do anything else, you must open the text file. This can
be done either by opening an existing file or by creating a new text
file. (When you create a new file, that file is automatically opened
and ready for use.) Either approach returns a reference to the
TextStream object. After you have a reference to the TextStream
object, you can either read from or write to the file. However, you
cannot simultaneously read from and write to the same file. In other
words, you cannot open a file, read the contents, and then write
additional data to the file, all in the same operation. Instead, you
must read the contents, close the file, and then reopen and write the
additional data. When you open an existing text file, the file can be
opened either for reading or for writing. When you create a new text
file, the file is open only for writing, if for no other reason than
that there is no content to read. Finally, you should always close a
text file. Although this is not required (the file will generally be
closed as soon as the script terminates), it is good programming
practice.
My code should work for your requirements. I've removed the While loop from the middle as if you are using ReadAll then you don't need to loop over the text.
Sub MySub()
Dim fso
Set fso = CreateObject("scripting.filesystemObject")
Dim file, folder
Dim path As String
Dim file_txt As String
path = "C:\users\folders\fileshere\"
Set folder = fso.GetFolder(path)
For Each file In folder.Files
Set file = fso.OpenTextFile(file.Path, 1)
Namechange = file.ReadAll
file.Close
Namechange = Replace(Namechange, "NAME", "name")
Set file = fso.OpenTextFile(file.Path, 2, True)
file.Write Namechange
file.Close
Next
End Sub
If you have any difficulties or would like further explanation of the above, let me know.
Some minor changes and it worked for me. Please change the path as per your own requirement in following code:
Sub change_txt()
Dim fso As Object
Set fso = CreateObject("scripting.filesystemObject")
Dim f
Dim path As String
Dim file_txt As String
path = "D:\Folder\Fileshare\"
file_txt = Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = fso.opentextfile(path & file_txt, 1)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange, "NAME", "name")
Set f = fso.opentextfile(path & file_txt, 2)
f.Write Namechange
file_txt = Dir()
Loop
End Sub
This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?
This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub
JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.
Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
I have an application that exports daily reports in txt format.
I have a macro that extracts certain lines of data from those reports and puts them in an output xls file. my macro's input directory is curently a separate folder that i manually move today's reports into.
I'd like for my macro to be able to just read from the default report folder and only read files created with today's date.
the naming convention of the report files is as follows:
1101_16_16_AppServiceUser_YYYYMMDDhhmmssXXX.txt
not sure what the last 3 digits on the file name represents, but they're always numbers.
Help?
WOW that was fast! thanks... fist time using stackoverflow.
I guess i should include the code that pulls data and dumps it to excel... here it is:
Sub PullLinesFromEPremisReport()
Dim FileName, PathN, InputLn As String
Dim SearchFor1, SearchFor2, OutpFile As String
Dim StringLen1, StringLen2 As Integer
Dim colFiles As New Collection
Dim bridgekey As String
PathO = "C:\Documents and Settings\GROMERO\Desktop\CM reconciliation\output\"
PathN = "C:\Documents and Settings\GROMERO\Desktop\CM reconciliation\input\"
FileName = Dir(PathN)
While FileName <> ""
colFiles.Add (FileName)
FileName = Dir
Wend
SearchFor1 = "BRIDGE KEY"
StringLen1 = Len(SearchFor1)
OutpFile = "RESULTS.xls"
Open PathO & OutpFile For Output As #2
For Each Item In colFiles
Open PathN & Item For Input As #1
Do Until EOF(1) = True
Line Input #1, InputLn
If (Left(LTrim$(InputLn), StringLen1) = SearchFor1) Then
bridgekey = InputLn
End If
Loop
Close #1
Next Item
Close #2
End Sub
Daniel's answer is correct, but using the FileSystemObject requires a couple of steps:
Make sure you have a reference to "Microsoft Scripting Runtime":
Then, to iterate through the files in the directory:
Sub WorkOnTodaysReports()
'the vars you'll need
Dim fso As New FileSystemObject
Dim fldr As Folder
Dim fls As Files
Dim fl As File
Set fldr = fso.GetFolder("C:\Reports")
Set fls = fldr.Files
For Each fl In fls
'InStr returns the position of the substring, or 0 if not found
' EDIT: you can explicitly use the reliable parts of your file name
' to avoid false positives
If InStr(1, fl.Name, "AppServiceUser_" & Format(Now, "YYYYMMDD")) > 0 Then
'Do your processing
End If
Next fl
End Sub
EDIT: So I think, from the code you posted, you could send PathN to the main Reports folder like you desire, then just modify your While statement like so:
While FileName <> ""
If InStr(1, FileName, "AppServiceUser_" & Format(Now, "YYYYMMDD")) > 0 Then
colFiles.Add (FileName)
End If
FileName = Dir
Wend
Two ways you can do this off the top of my head. Assuming you are using a File via the FileSystemObject.
Do an Instr on the file.Name looking for Format(Date, "YYYYMMDD") within the string.
Or use a far simpler approach loop through the files and within your loop do this:
If File.DateCreate >= Date Then
'Do something
end if
Where File is the actual variable used to for looping through the files.
If fileName like "*AppServiceUser_" & Format(Now, "YYYYMMDD") & _
"#########.txt" Then
'good to go
End If
I am trying to loop through a given directory to find the latest downloaded csv file. For some reason my Dir function won't find any file even if the file does exist. I am not totally familiar with VBA so i may perhaps be missing some sort of reference to perform the Dir function, but I can't find anything online that tells me I need to. All the examples and forums use Dir just like I do, but I can't get mine to work. Here is the code, please tell me if you can see what I am doing wrong:
Public Function Get_File() as string
Dim filePath As String
ChDir ("..")
filePath = CurDir
'Goes back to Documents directory to be in same directory as macro
ChDir (filePath & "\Documents")
filePath = filePath & "\Downloads\test.txt"
filePath = getLatestFile(filePath)
Get_File = filePath
End Function
Public Function getLatestFile(pathToFile As String) As String
Dim StrFile As String
Dim lastMod As Variant
Dim nextMod As Variant
Dim lastFileName As String
StrFile = Dir(pathToFile)
lastFileName = StrFile
lastMod = FileDateTime(StrFile)
While Len(StrFile) > 0
Debug.Print StrFile
StrFile = Dir
nextMod = FileDateTime(StrFile)
If nextMod > lastMod Then
lastFileName = StrFile
lastMod = nextMod
End If
Wend
getLatestFile = lastFileName
End Function
The test.txt file is in my Downloads file and the filePath string prints out to be the correct path, but I keep getting an error stating that it can't find the file. It fails at the first use of Dir(pathToFile). Any help would be greatly appreciated.
Dir() only returns the filename portion of the path, i.e., it does not return the folder portion. For example,
Dir("C:\MyPath\MyFile.txt")
returns MyFile.txt not C:\MyPath\MyFile.txt