I am working on a project in VBA where I'm searching a directory for files of a certain date that also meet other criteria, and all of that is working fine. What I am stuck on, which should be a trivial issue, is that when I try to use FileCopy to copy the file to another folder, I keep getting a path/file access error. This confuses me because I am pulling the path directly from the FileItem I'm using to search for the criteria, I'm the person who created both the source and destination folders, and put the files in the source folder. Any thoughts?
Sub ListFilesInFolder()
Dim counter As Integer
Dim theString1 As String, theString2 As String
theString1 = "ISA*00*"
theString2 = "ISA|00|"
Dim line As String, fileName As String
Dim datestring As String
'datestring = Format(FileItem.DateLastModified, "mm/dd/yyyy")
Dim today As String
today = Format(DateAdd("d", -2, Date), "mm/dd/yyyy")
Dim destinationFolder As String
destinationFolder = "C:\Users\kragan\Desktop\test\folder2"
Dim file As TextStream
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Set SourceFolder = FSO.GetFolder("C:\Users\kragan\Desktop\test\folder1")
Dim FileItem As Scripting.file
For Each FileItem In SourceFolder.Files
datestring = "10/18/2015"
If (datestring = today) Then
Do While (SourceFolder <> "")
Set file = FSO.OpenTextFile(FileItem)
counter = 0
Do While Not file.AtEndOfLine And counter < 1
line = file.ReadLine
If InStr(1, line, theString1, vbTextCompare) > 0 Or InStr(1, line, theString2, vbTextCompare) > 0 Then
fileName = "C:\Users\kragan\Desktop\test\folder1\" + FSO.GetBaseName(FileItem) + ".AETCLS"
'The line where I get the error:
FileCopy fileName, destinationFolder
file.Close
counter = counter + 1
Exit Do
End If
Loop
Loop
End If
Next FileItem
MsgBox ("done")
End Sub
You need to specify destination folder + destination file name (and not only destination folder).
So this will work:
FileCopy fileName, destinationFolder & "\" & FSO.GetBaseName(FileItem) & ".AETCLS"
You were probably assuming this will work like a file manager application, where giving destination folder is enough... :) But when programming, you need to specify destination path exactly as it is, i.e. including the file name.
One of my friends was getting similar error on creating directory newdir1\newdir2\newdir3. It was not working despite his best effort. But the solution was to create newdir1, then it became possible to specify newdir1\newdir2, then finally newdir1\newdir2\newdir3. Programming file operations does not do the job often seen in file managers, but everything must be specified in detail and performed in elementary steps.
Thanks for your help. What I discovered is that you have to have the full destination path, including the file name, even though it isn't changing. Solved!
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’ve made a simply macro to change names of files in a directory. At first it seemed correct, but then I’ve noticed something strange. For instance there is 48 files in a directory and initially the macro numbers files properly – “1”, “2”, “3” and so forth (in Immediate window the variable “i” changes from 1 to 49), but if I run the macro several times, sometimes the variable “i” changes from 1 to 148 and a first number of files starts from 100: “100”, “101”, “102” et cetera. Then I run the macro again and it counts files properly, then – again – an error mentioned above occurs … and so on. I don’t see any rule in it. Any help is greatly appreciated.
Sub nameChange()
Dim source As FileSystemObject
Dim fold As folder
Dim fObj As File
Dim path As String, newName As String, number As String, ext As String
Dim i As Long
On Error GoTo closeSub
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End With
Set source = New FileSystemObject
Set fold = source.GetFolder(path)
i = 1
newName = InputBox("New name")
For Each fObj In fold.Files
ext = Mid(fObj.Name, (InStrRev(fObj.Name, ".")))
Name fObj As path & "\" & newName & i & ext
i = i + 1
Next fObj
closeSub:
Exit Sub
End Sub
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