I have code in access VBA to copy file form serwer to user path
FromPath = "\\xx.xx.xx.xx\zz.zzzz\" & folder & "\"
ToPath = "C:\newfolder\" & b & "\"
File = barkod & ".tif"
FileCopy FromPath & File, ToPath & File
barcode is string
I have file that name is barcode_"random alphanumeric characters".tif
how yo copy this file with random alphanumeric characters in name
this is example of file name:
412355557816_17385084
412355557816_15987047
Code like this isn't working :(
File = master & "_" & "*" & ".tif"
What should be in "*"?
Another proposal, using dir command to list files matching a certain pattern
FromPath = "\\xx.xx.xx.xx\zz.zzzz\" & folder & "\"
ToPath = "C:\newfolder\" & b & "\"
f = Dir(FromPath & barkod & "*.tif")
While f <> ""
FileCopy FromPath & f, ToPath & f
f = Dir()
Wend
Use like in combination with the wildcard operator *
Sub testlike()
barcode = "412355557816*"
If "412355557816_17385084" Like barcode Then
Debug.Print "Match"
End If
End Sub
Related
I have facing an error while executing this code. If a file already exists in a destination folder it gives error. If a file does not exists it smoothly moves the files into the updated Date folder.
Can anyone please help so that in case if a file already exists in the destination folder the code does not give error. It can either replace the file with the new one or it can remain in the Source folder.
Sub moveAllFilesInDateFolder()
Dim DateFold As String, fileName As String
Const sFolderPath As String = "E:\Uploading\Source"
Const dFolderPath As String = "E:\Uploading\Archive"
DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
fileName = Dir(sFolderPath & "\*.*")
Do While fileName <> ""
Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
fileName = Dir
Loop
End Sub
This will be much appreciated.
Please, use this updated code. You cannot use Dir (once more) to check the file existence, because it will perturbate the existing loop. So, a VBScript object should be used. And naming will not be done, anymore. Name method is not able to overwrite an existing file:
Sub moveAllFilesInDateFolderIfNotExist()
Dim DateFold As String, fileName As String, objFSO As Object
Const sFolderPath As String = "E:\Uploading\Source"
Const dFolderPath As String = "E:\Uploading\Archive"
DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
fileName = Dir(sFolderPath & "\*.*")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do While fileName <> ""
If Not objFSO.FileExists(DateFold & "\" & fileName) Then
Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
End If
fileName = Dir
Loop
End Sub
I want to add attachments from a specific folder. I specified the file's path and two keywords which are fixed.
There are more characters to complete the file path after 'filename2' and before 'pmonth' which are not fixed and hence I need to use wildcard (*).
The code gives
'Couldn't find file'
I have gone through various threads and tried solutions. None works for what I want.
For ctr = 2 To lastrow
filename1 = Cells(ctr, 1).Value
filename2 = Cells(ctr, 3).Value
Set OutMail = OutApp.CreateItemFromTemplate(str_template)
path = "C:\Users\nikunj.v.tripathi\Desktop\" & filename1 & "_" & filename2 & " -" & "*" & pmonth & " " & syear & ".xlsx"
With OutMail
.Attachments.Add path ' <----- this line gives error
.To = Cells(ctr, 10).Value
.cc = Cells(ctr, 11).Value
.htmlbody = Replace(.htmlbody, "#Month#", smonth)
.htmlbody = Replace(.htmlbody, "#CLIENT NAME#", Cells(ctr, 1).Value
.Save
End With
Next ctr
To use the Dir function effectively in this case, you'll need the path and the file name as two separate variables. Assuming you add another variable called filename, you could then utilise the following code...
...
path = "C:\Users\nikunj.v.tripathi\Desktop\"
filename = filename1 & "_" & filename2 & " -" & "*" & pmonth & " " & syear & ".xlsx"
...
filename = Dir(path & filename) ' Dir returns the filename of the first file matching
' the criteria, or returns an empty string if no match.
Do Until filename = ""
.Attachments.Add path & filename
filename = Dir ' Using Dir again returns the next file matching
' the criteria, or returns an empty string if no match.
Loop
Of course - Attachments.Add adds a single attachment and returns the Attachment object. How can it possibly add multiple attachments?
You can use Scripting.FileSystemObject to loop through all files in a folder and add one attachment at a time. See, for example
https://devblogs.microsoft.com/scripting/how-can-i-get-a-list-of-all-the-files-in-a-folder-and-its-subfolders/
I am using MS Access Forms and I am trying to open a file but don't know how to open the file based knowing only part of the name. Example below works
Private Sub Open_Email_Click()
On Error GoTo Err_cmdExplore_Click
Dim x As Long
Dim strFileName As String
strFileName = "C:\data\office\policy num\20180926 S Sales 112.32.msg"
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
Exit_cmdExplore_Click:
Exit Sub
Err_cmdExplore_Click:
MsgBox Err.Description
Resume Exit_cmdExplore_Click
End Sub
If I change the strFilename to being
strFileName = "C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
It includes the * rather than using it as a wildcard, the date/numbers can be anything or in another format but always eight numbers. I tried using a while loop on the numbers but I am not sure the best way of doing this sorry.
You can use the Dir function to iterate over all files that match a string pattern.
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
Dim strFilePattern As String
strFilePattern ="C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
Dim strFileName As String
strFileName = Dir(strFilePattern)
Do While Not strFileName = vbNullString
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
strFileName = Dir
Loop
The first call to Dir with the pattern as a parameter will find the first file that matches the pattern supplied. All subsequent calls without the pattern will return the next file that matches the pattern.
So, lets rebuild the question a bit. Imagine that you are having the following 5 files in a given folder:
A:\peter.msg
A:\bstack.msg
A:\coverflow.msg
A:\heter.msg
A:\beter.msg
and you need to find the files, that correspond to "A:\*eter.msg" and print them.
For this, you need to use the keyword Like:
Sub TestMe()
Dim someNames As Variant
someNames = Array("A:\peter.msg", "A:\bstack.msg", _
"A:\coverflow.msg", "A:\heter.msg", "A:\beter.msg")
Dim cnt As Long
For cnt = LBound(someNames) To UBound(someNames)
If someNames(cnt) Like "A:\*eter.msg" Then
Debug.Print someNames(cnt)
End If
Next
End Sub
Loop through files in a folder using VBA?
I developed a code that loops through files and folders' names found in an Excel Spreadsheet, finds them in a folder and deletes them.
The problem is that there are some files and folders that don't appear on the spreadsheet, but still need to be deleted.
My goal is to have more free space.
Someone suggested i copied the folder list into another column, match the file names and then delete the ones that don't match.
I'd prefer automation, though.
Any suggestions?
Thanks in advance!
Code:
Sub DeleteSpecificFilesAndFolders()
'This module deletes Extracted Files folders, Flat Files folders and Final Flat Files (.txt format)
Const path = "C:\Users\N\Desktop\Kill_function_test\Test folder for deleting\"
Dim r As Range
Dim r2 As Range
Dim folderpath As String
Dim folderpath_1 As String
Dim fso As FileSystemObject
Set fso = New Scripting.FileSystemObject
Set r2 = Cells(2, 1)
Do Until r2 = ""
folderpath = path & r2 & "\" & "Extracted Files"
'Checks if the folder exists and then deletes it.
If fso.FolderExists(folderpath) Then
fso.DeleteFolder (folderpath)
End If
'Checks if the folder exists and then deletes it
folderpath_1 = path & r2 & "\" & "Flat Files"
If fso.FolderExists(folderpath_1) Then
fso.DeleteFolder (folderpath_1)
End If
Set r2 = r2.Offset(1, 0)
DoEvents
Loop
'Loops through and deletes the "INACTIVE" Final Flat Files (.txt)
Set r = Cells(1, 5)
Do Until r = ""
If UCase(r.Value) = "INACTIVE" Then
'Checks if the extracted flat file exists.
If Dir(path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt") <> "" Then
Kill path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt"
End If
End If
Set r = r.Offset(1, 0)
Loop
End Sub
Try the code below. I used the Dir() command/function. This allows you to obtain all the folder/files that exists in a path.
Sub DeleteSpecificFilesAndFolders()
'This module deletes Extracted Files folders, Flat Files folders and Final Flat Files (.txt format)
Const path = "C:\Users\N\Desktop\Kill_function_test\Test folder for deleting\"
Dim r As Range
Dim folderpath As String
Dim folderpath_1 As String
Dim FolderName As String
Dim fso As FileSystemObject
Set fso = New Scripting.FileSystemObject
FolderName=Dir(Path & "*", vbDirectory)
While FolderName <> ""
if Not FolderName like "*.*" then 'This is because when using Dir(,vbdirectory) you can get . and .. or if files exist
folderpath = path & FolderName & "\" & "Extracted Files"
'Checks if the folder exists and then deletes it.
If fso.FolderExists(folderpath) Then
fso.DeleteFolder (folderpath)
End If
'Checks if the folder exists and then deletes it
folderpath_1 = path & FolderName & "\" & "Flat Files"
If fso.FolderExists(folderpath_1) Then
fso.DeleteFolder (folderpath_1)
End If
end if
FolderName=Dir() 'This will set FolderName to the next folder
DoEvents
wend
'Loops through and deletes the "INACTIVE" Final Flat Files (.txt)
Set r = Cells(1, 5)
Do Until r = ""
If UCase(r.Value) = "INACTIVE" Then
'Checks if the extracted flat file exists.
If Dir(path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt") <> "" Then
Kill path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt"
End If
End If
Set r = r.Offset(1, 0)
Loop
End Sub
Hope this helps
I have code to find a filename from column A and rename files as in column B in a source folder and then copy to a new folder.
The code is as below.
Sub Rename_Files()
Dim SourcePath, DestPath, Fname, NewFName
SourcePath = "C:\Invoices\"
DestPath = "C:\Invoices\Renamed\"
For i = 1 To 100
Fname = Range("A" & i).Value
NewFName = Range("B" & i).Value
If Not Dir(SourcePath & Fname, vbDirectory) = vbNullString Then
FileCopy SourcePath & Fname, DestPath & NewFName
Else
MsgBox (Fname & " Not Exists in Folder")
End If
Next i
End Sub
The problem is that The filenames in the source directory are long like 'INVOICEDUMP_OFND_4294819_ABC Corp.pdf' and hundreds of like this.
I want to find the file containing 4294819 (from column A) in the name and then replace the name with only 'INV 4294819.pdf' (as mentioned in column B).
Thanks
Unless my DOS skills are extremely rusty, you should be able to use
Sub Rename_Files()
Dim SourcePath As String, DestPath As String, Fname As String, NewFName As String
Dim i As Long
SourcePath = "C:\Invoices\"
DestPath = "C:\Invoices\Renamed\"
For i = 1 To 100
If Not IsEmpty(Range("A" & i).Value) Then
NewFName = Range("B" & i).Value
'Search for the first file containing the string in column A
Fname = Dir(SourcePath & "*" & Range("A" & i).Value & "*")
If Fname <> vbNullString Then
FileCopy SourcePath & Fname, DestPath & NewFName
Else
MsgBox Range("A" & i).Value & " Not Exists in Folder"
End If
End If
Next i
End Sub
This assumes that column A has entries such as 4294819 and that the corresponding entry in column B is something like INV 4294819.pdf.