I am new in VBA, so I have a list of document (just file name, without extension .pdf, .docx, etc) in excel column. What I would like to do is to copy all document in the list, from source folder to destination folder.
I already tried some code, it works but the code copy all the files in the folder instead of the file in list (The document list is only in B3:B10).
Any help really appreciated.
Thanks in advance.
Sub copyfile()
Dim r As Range
Dim Jajal As Range
Dim sourcePath As String, DestPath As String, FName As String
sourcePath = "C:\Users\"
DestPath = "H:\Users\"
For Each r In Range(Sheet6.Range("B3"), Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
FName = Dir(sourcePath & r)
'Loop while files found
Do While FName <> ""
'Copy the file
FileCopy sourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
Next
End Sub
You shouldn't need the Dir method
For Each r In Range(Sheet6.Range("B3"), Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
FileCopy sourcePath & r.value, DestPath & r.value
Next
Related
Sub CheckandSend()
Dim strfile As String
Dim ws As Worksheet 'make sure to define a sheet
Set ws = ThisWorkbook.Worksheets("RFQ")
Sheets("RFQ").Select
Dim Sourcepath As String
Sourcepath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VALEO FRANCE 35101380FM\Drg folder\"
Dim destpath As String
destpath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VALEO FRANCE 35101380FM\New folder1\"
'make sure paths end with \
Dim irow As Long
Dim f As SearchFolders
Dim filetype As String
filetype = "*.pdf"
irow = 7
Do While ws.Cells(irow, 2) <> vbNullString
Dim FileName As String
FileName = Dir(Sourcepath & ws.Cells(irow, 2) & "*.pdf")
'this will only go through pdf files
Do While FileName <> vbNullString
'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
VBA.FileCopy Sourcepath & FileName, destpath & FileName
'copy needs to be path AND filename
FileName = Dir()
Loop
irow = irow + 1
Loop
Sheets("RFQ").Select
Columns("AB:AG").Select
Selection.Delete
End Sub
on here , this code is help me to find a pdf file which matches my excel cell data and after that finding a file it will copy that particular file and paste in the destination folder
my issue is my file name in excel will look like
AVRO15VE1522A,
AVRO15VE1523B,
AVRO15VE1524C , (In the file name list, the last alphabet is revision it may change as A,B,C,D,E.....Z)
but in my folder the file name will be like
AVRO15VE1522 A, (OR) AVRO15VE1522A,
AVRO15VE1523 B, (OR) AVRO15VE1523B,
sometimes multiple files with same file name will present ,so i want only one file on that particular file name
and if all the revision files which is
AVRO15VE1522A,
AVRO15VE1522B,
AVRO15VE1522C,
Is present in folder means , i want the code to take a file which matches my filename in excel range
I want copy pdf from source folder and have to paste in destpath based on Excel, help me where I am gone wrong
Sub CheckandSend()
Dim irow As Integer
Dim DestPath As String
Dim SourcePath As String
Dim pfile As String
Dim FSO As Object
Dim Fldr As Object, f As Object
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder(SourcePath).Files
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1"
irow = 7
Do While Cells(irow, 2) <> Empty
pfile = Dir(SourcePath & "\*" & Cells(irow, 2) & "*")
If pfile <> "" And Right(pfile, 3) = "PDF" Then
FileCopy SourcePath, DestPath
irow = irow + 1
End If
Loop
end sub
You are mixing 2 different methods: The FileSystemObject and Dir(). Only use one of them.
FileCopy SourcePath, DestPath only copies the path but there is no filename.
Directly include the file extension in your Dir() so you don't need to check for pdf files:
FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf")
There may exist more than one file with the key word from your cell. Your code copies randomly one of them. Make sure to loop so you get all of them
Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
FileName = Dir()
Loop
It could look like this:
Option Explicit
Public Sub CheckandSend()
Dim ws As Worksheet 'make sure to define a sheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim SourcePath As String
SourcePath = "C:\Temp\" 'make sure paths end with \
Dim DestPath As String
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\" 'make sure paths end with \
Dim iRow As Long
iRow = 7
Do While ws.Cells(iRow, 2) <> vbNullString
Dim FileName As String
FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf") 'this will only go through pdf files
Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
FileName = Dir()
Loop
iRow = iRow + 1
Loop
End Sub
The code below works.
Sub CheckandSend()
' 191
Const Ext As String = ".pdf"
Dim SourcePath As String
Dim DestPath As String
Dim FSO As Object
Dim Fldr As Object
Dim pFile As String
Dim f As Object
Dim iRow As Long ' row numbers should be declared as Long
' both paths must end on backslash ("\")
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor\"
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder(SourcePath).Files
' loop until last used cell in column B
For iRow = 7 To Cells(Rows.Count, 2).End(xlUp).Row
pFile = Trim(Cells(iRow, 2).Value)
If Len(pFile) = 0 Then Exit For ' exit at first blank row
If LCase(Right(pFile, 4)) <> Ext Then pFile = pFile & Ext
If Len(Dir(SourcePath & pFile)) Then
FileCopy SourcePath & pFile, DestPath & pFile
End If
Next iRow
End Sub
There are a few inconsistencies in your procedure which I have eliminated. For example, your code isn't clear whether the file name in the worksheet has a pdf extension or not, then looks for any file by that name but rejects all that aren't "pdf". The above code rephrases this to mean that you want a PDF file by the name in the worksheet and any file by the same name but another extension is to be ignored. It's the same, I think, but more efficient if you limit the search to PDF.
The other thing is the end of the loop. Is it when there are no more file names or when a cell is blank? The above code ends in either case. I presume that is OK because there are no blanks in your list of files. If so, it would be better, however, to just skip any accidental blanks and continue until the last line has been processed. If you agree, delete the Exit For and set an End If at the appropriate point (before the Next iRow) and indent all lines in between.
I am new in VBA, so I have a list of document (with extension .pdf, .docx, etc) in excel column. What I would like to do is to copy all document in the list, from source folder to destination folder.
I already tried some code, it works but the code copy all the files in the folder instead of the file in list (The document list is only in B3:B10).
Any help really appreciated.
Thanks in advance.
Sub copyfile()
Dim r As Range
Dim Jajal As Range
Dim sourcePath As String, DestPath As String, FName As String
sourcePath = "C:\Users\"
DestPath = "H:\Users\"
For Each r In Range(Sheet6.Range("B3"), Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
FName = Dir(sourcePath & r)
'Loop while files found
Do While FName <> ""
'Copy the file
FileCopy sourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
Next
End Sub
Copy Files From Range (List)
The Code
Option Explicit
' This will copy files found in a source path AND whose names
' are contained in a list (range), to a destination path,
' overwriting possible existing files.
Sub copyFiles()
Const SourcePath As String = "C:\Users\"
Const DestPath As String = "H:\Users\"
Const ListAddress As String = "B3:B10"
' Write file list to array.
Dim FileList As Variant: FileList = Sheet1.Range(ListAddress).Value
' 'Get' first file name.
Dim FName As String: FName = Dir(SourcePath)
' 'Initiate' counter.
Dim i As Long
' Loop files in SourcePath.
Do While FName <> ""
' Check if file name of current file is contained in array (FileList).
If Not IsError(Application.Match(FName, FileList, 0)) Then
' Count file.
i = i + 1
' Copy file.
FileCopy SourcePath & FName, DestPath & FName
End If
' 'Get' next file name.
FName = Dir()
Loop
' Inform user.
Select Case i
Case 0: MsgBox "No files found", vbExclamation, "No Files"
Case 1: MsgBox "Copied 1 file.", vbInformation, "Success"
Case Else: MsgBox "Copied " & i & " files.", vbInformation, "Success"
End Select
End Sub
Using Dir you loop over all the files in the directory. If you know your files, you don't need Dir. Try like the following (not tested):
Sub copyfile()
Dim r As Range
Dim Jajal As Range
Dim sourcePath As String, DestPath As String
sourcePath = "C:\Users\"
DestPath = "H:\Users\"
For Each r In Range(Sheet6.Range("B3"), Sheet6.Range("B10")) 'the list document is in the sheet6 B3:B10
'Loop while files found
If r.Value <> ""
'Copy the file
FileCopy sourcePath & r.Value, DestPath & r.Value
'Search the next file
End If
Next
End Sub
However, you could test if the file exists before you copy.
Maybe someone can help me.
I am looking for a vba code thats searches in a folder for kewords of the filename, and then moves these found files to anthor folder.
The keywords are stored in column A in excel.
I have used the following code and it works partly. The problem is that column A has to contain the exact filename in the following code. I want vba to search for keywords. The other thing is that the files have to be moved instead of been copied. And if a file has been moved that there is check in column B.
Sub Test()
Dim R As Range, r1 As Range
Dim SourcePath As String, DestPath As String, FName As String
SourcePath = "C:\Downloads\"
DestPath = "C:\Downloads\New folder\"
Set r1 = Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each R In r1
FName = Dir(SourcePath & R)
Do While FName <> ""
If Application.CountIf(r1, FName) Then
FileCopy SourcePath & FName, DestPath & FName
R.Offset(0, 1).Value = FName
Else
MsgBox "Bad file: " & FName & " ==>" & FName & "<== "
End If
FName = Dir()
Loop
Next
End Sub
You can use wildcards in the Dir function if your range only contains keywords of the file. Like this:
FName = Dir(SourcePath & "*" & R.Value & "*")
It will then process all files where this keyword is used in.
I am attempting to use VBA to open all the excel files in a directory (in this case c:\temp) and put all the files datasheets in one large file. Each new sheet is named with the filename plus the name of the sheet on the original document. The code that I have copies the first file's first sheet and even names it correctly, but then fails with a Run-time error 1004: Application defined or object defined error on the second sheet when I try to set the name. Anyone have any suggestions on how to fix.
Sub MergeAllWorkbooks()
Dim FolderPath As String
Dim FileName As String
' Create a new workbook
Set FileWorkbook = Workbooks.Add(xlWBATWorksheet)
' folder path to the files you want to use.
FolderPath = "C:\Temp\"
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
Dim currentSheet As Worksheet
Dim sheetIndex As Integer
sheetIndex = 1
Windows(WorkBk.Name).Activate
For Each currentSheet In WorkBk.Worksheets
currentSheet.Select
currentSheet.Copy Before:=Workbooks(FileWorkbook.Name).Sheets(sheetIndex)
FileWorkbook.Sheets(sheetIndex).Name = FileName & "-" & currentSheet.Name
sheetIndex = sheetIndex + 1
Next currentSheet
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
End Sub
Replace
FileWorkbook.Sheets(sheetIndex).Name = FileName & "-" & currentSheet.Name
with (I separated it out for readability)
sWSName = FileName & "-" & currentSheet.Name
sWSName = NameTest(sWSName)
sWSName = TestDup(sWSName)
FileWorkbook.Sheets(sheetIndex).Name = sWSName
You will need to define the sWSName.
Below are the modified functions I have previously used.
Function NameTest(sName As String) As String
NameTest = sName
aSpecChars = Array("\", "/", "*", "[", "]", ":", "?")
For Each c In aSpecChars
NameTest = Replace(NameTest, c, "")
Next c
If Len(sName) > 31 Then NameTest = Left(sName, 31)
End Function
Function TestDup(sWSName As String) As String
TestDup = sWSName
For Each ws In Worksheets
Debug.Print ws.Name
If sWSName = ws.Name Then TestDup = TestDup(Left(sWSName, Len(sWSName) - 1))
Next ws
End Function
If posting this code (or to this extent) is out of line please let me know as I am still coming to terms with the level of effort require versus reasonable response.