dracoholikus
New Member
- Joined
- Feb 28, 2021
- Messages
- 4
- Office Version
- 2016
- Platform
- Windows
Hello, recently i found a macro from this post,
And it really helped me as i have a time consuming copy-paste files process in CAD designing, but i require a modification to the program so i can acess the full potential of the tool and lack the knowledge to do it.
So the situation is,
ACTUAL PROGRAM(extracted and minimally modified)
NEW PROGRAM
I intend to use this to make some "quick-send" laser cutting material based on a excel list that i export from the SOLIDWORKS Bill of Materials. The SolidWorks export has its own program(that i created using it's API) that export the excel list exactly like the image below, all formatted,
Red = the codes the program will search;
Blue = the materials that it will use to create specific folders;
Yellow = from left to right, equipament model, my internal system code and revision of design;
VBA Code:
Can anyone enlight me on how to procede with the modification? I want to learn how to start modifying, with some guidance if possible...
Vba- copying PDF from subfolders to a new folder
Hi, I am having a hard time with my vba code. I’m trying to move some specific PDF Files that are in subfolders to a new folder but the code it’s copying every PDF files from those subfolders. Here is the code: Sub CopyFiles_DEBUG() Dim sPathSource As String, sPathDest As String...
www.mrexcel.com
And it really helped me as i have a time consuming copy-paste files process in CAD designing, but i require a modification to the program so i can acess the full potential of the tool and lack the knowledge to do it.
So the situation is,
ACTUAL PROGRAM(extracted and minimally modified)
- The user inputs the folder for the files to be pasted;
- The user select which cells contains the filenames that will be searched on a main directory(inserted on the program);
- The program initiate it's search for the file extensions ".pdf" and ".dxf", when it finds, copy and paste into the selected folder;
- Program ends;
NEW PROGRAM
- The user inputs the main folder for the files to be pasted;
- The user select which cells contains the filenames that will be searched on a main directory(inserted on the program);
- The user select which cells contains the materials that will be used to create each specific subfolder on the main folder;
- It will compare the material name on the excel list with a set of string variables, like,
- CHAPA AÇO 1020 1,20MM = 1,2mm(string use to name the folder);
- It will compare the material name on the excel list with a set of string variables, like,
- The user select which cell contains the model of the machine - yellow area in the image, "LFH 40";
- The user select which cell contains the code of the machine - yellow area in the image, "61962";
- The user select which cell contains the revision of the machine - yellow area in the image, "rev 03";
- The program creates subfolders using the material, model, code and revision, like the image below,
- The program initiate it's search for the file extensions ".pdf" and ".dxf", when it finds, it will copy and paste the files into the subfolder that relates to the material of the part, in the image below, the file "0005.0001.0117" will be pasted in the "LFH 40 1,2mm (61962) (rev 03)" subfolder;
- Program ends;
I intend to use this to make some "quick-send" laser cutting material based on a excel list that i export from the SOLIDWORKS Bill of Materials. The SolidWorks export has its own program(that i created using it's API) that export the excel list exactly like the image below, all formatted,
Red = the codes the program will search;
Blue = the materials that it will use to create specific folders;
Yellow = from left to right, equipament model, my internal system code and revision of design;
VBA Code:
VBA Code:
Option Explicit
Public Sub CopyFiles_Partial_File_Names()
Dim sourcePath As String, destinationPath As String
Dim filesRange As Range
sourcePath = "C:\Users\Avell\Google Drive LTCH\SOLIDWORKS" 'main folder and its subfolders to search for the partial file names
destinationPath = Application.InputBox("Input destination folder to all files:", , , , , , , 2) 'folder where matching file names will be copied to
On Error Resume Next
Set filesRange = Application.InputBox("Please select the cells containing partial file names to be copied:", "Copy Files", ActiveWindow.RangeSelection.Address, , , , , 8)
On Error GoTo 0
If filesRange Is Nothing Then Exit Sub
Copy_Matching_PDF_Files filesRange, sourcePath, destinationPath
End Sub
Private Sub Copy_Matching_PDF_Files(filesRange As Range, sourceFolder As String, ByVal destinationFolder As String)
Static FSO As Object
Dim FSfile As Object
Dim FSfolder As Object
Dim fileCell As Range
Dim model As String
Dim revision As String
Dim code As String
Dim ac120 As String
Dim ac200 As String
Dim ac318 As String
Dim ai120 As String
Dim folderac120 As String
Dim folderac200 As String
Dim folderac318 As String
Dim folderai120 As String
Dim fileMaterial As Range
Set model = Worksheets(ActiveSheet.Name).Cells(1, "A").Value
Set revision = Worksheets(ActiveSheet.Name).Cells(1, "C").Value
Set code = Worksheets(ActiveSheet.Name).Cells(1, "B").Value
Set ac120 = "CHAPA AÇO 1020 1,20MM"
Set ac200 = "CHAPA AÇO 1020 2,00MM"
Set ac318 = "CHAPA AÇO 1020 3,18MM"
Set ai120 = "CHAPA INOX 304 1,2MM ESCOVADO COM PELICULA"
Set folderac120 = "1,20mm"
Set folderac200 = "2,00mm"
Set folderac318 = "3,18mm"
Set folderai120 = "INOX 304 1,20mm"
Set fileMaterial = filesRange.Offset(, 2)
If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
Set FSfolder = FSO.GetFolder(sourceFolder)
For Each fileCell In filesRange
For Each FSfile In FSfolder.Files
If LCase(FSfile.Name) Like LCase("*" & fileCell.Value & "*.pdf") Then
Debug.Print "COPY " & FSfile.Path & " TO " & destinationFolder
FSfile.Copy destinationFolder, OverwriteFiles:=True
End If
Next
Next
For Each fileCell In filesRange
For Each FSfile In FSfolder.Files
If LCase(FSfile.Name) Like LCase("*" & fileCell.Value & "*.dxf") Then
Debug.Print "COPY " & FSfile.Path & " TO " & destinationFolder
FSfile.Copy destinationFolder, OverwriteFiles:=True
End If
Next
Next
For Each FSfolder In FSfolder.SubFolders
Copy_Matching_PDF_Files filesRange, FSfolder.Path, destinationFolder
Next
End Sub
Can anyone enlight me on how to procede with the modification? I want to learn how to start modifying, with some guidance if possible...