Macro VBA to save/copy specific files located at specific folder to another folder that the user can choose with a folder dialog

[prati]

Hey

I have macros that creates several pdf files at specific folder.
The file names are as follows:

Article.pdf
Article.part1.pdf
Article.part2.pdf
Article.part3.pdf

The files are always in pdf format

The location is always C:\Temp

The filenames are always the same

In another words the paths of those four files and the names remain the same as follows:

C:\Temp\Article.pdf
C:\Temp\Article.part1.pdf
C:\Temp\Article.part2.pdf
C:\Temp\Article.part3.pdf

Until now it was a background of several macros that in the end produces those files - Now I will get to my question.

Now I would like to ask for help in order to write a new macro with my very little knowledge.

I'm searching for a Macro VBA that will prompt the user to save those four specific files with folder dialog.

In another words the macro will open a folder dialog and ask the user where does he want to save those four specific files - and copy them to the choosen folder

With my current little Knowledge I only know how to copy a file from a specific location to another specific location

Sub Copy_Four_Files()

FileCopy "C:\Temp\article.pdf", "C:\AnotherLocation\article.pdf"
FileCopy "C:\Temp\article.part1.pdf", "C:\AnotherLocation\article.part1.pdf"
FileCopy "C:\Temp\article.part2.pdf", "C:\AnotherLocation\article.part2.pdf"
FileCopy "C:\Temp\article.part3.pdf", "C:\AnotherLocation\article.part3.pdf"

End Sub

I want to change the Macro so that the user can choose where to save/copy those four specific files, and if possible also to rename the files during the process of the folder dialog / save as.

Thanks in advance,

 

[Zot]

I don't know if it is possible to copy and and ask for destination folder without opening the source file. The code will automatically open all files in source folder on the fly and prompt for destination folder.

Sub SaveExcelFilePrompt()

Dim SourcePath As String, OutputFolder As String
Dim FName As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim SaveDialogBox As Object

'Loop through all files in Source Folder
SourcePath = "D:\Temp\"        ' Set your folder path here
FName = Dir(SourcePath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=SourcePath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    For Each ws In wb.Sheets
        Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
        If SaveDialogBox.Show = -1 Then
            OutputFolder = SaveDialogBox.SelectedItems(1)
            wb.SaveAs Filename:=OutputFolder & "\" & wb.Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        End If
    Next
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

 

[prati]

Thank you friend,
The code you wrote above can help to someone who need to deal with excel files...
I need a macro to save pdf files with folder dialog

If you think that the pdf should be open before save it to another location, I have the code to open pdf but I want to add lines for save as with folder dialog.

Here Is the code that open C:\Temp\article.pdf

Sub OpenPdf()

On Error Resume Next
OpenPDFPage "C:\Temp\article.pdf", 115, 2

'Page view options:
'0: Full Page
'1: Zoom to 100%
'2: Page Width

Call Shell("explorer.exe" & " " & "C:\Temp", vbNormalFocus) 'This line open the pdf file for viewing but not prompt the user

End Sub

Now that the file is open (if you think we must open the file)

Do you have any idea what lines should I add In order to prompt the user to save article.pdf with folder dialog?

 

[Zot]

I don't know where my mind was. It is clearly that you were asking about pdf ?

I've never done one. Let me find out, hoping someone can beat me ?

 

[Zot]

Try the code below. I did not tick any reference to Acrobat in VB Editor and it worked. Probably because my PC have Acrobat installed. I just use Hyperlink to open pdf file. It is simpler.

Let me know if this works. Note that like before, the files are not deleted from original location.

Sub SavePdfFilePrompt()

Dim SourcePath As String, OutputFolder As String
Dim FName As Variant
Dim wb As Workbook
Dim AcroApp As Object
Dim PDDoc As Object
Dim avdoc As Object
Dim SaveDialogBox As Object
Dim IsSaved As Boolean

Set wb = ActiveWorkbook
Set AcroApp = CreateObject("AcroExch.App")

If Err.Number <> 0 Then
    MsgBox "Could not create the App object!", vbCritical, "Object error"
    'Release the object and exit.
    Set AcroApp = Nothing
    Exit Sub
End If
        
'Loop through all files in Source Folder
SourcePath = "D:\Test\"        ' Set your folder path here
FName = Dir(SourcePath)

While FName <> ""
    ' Open pdf file
    wb.FollowHyperlink SourcePath & FName
    Set avdoc = AcroApp.GetActiveDoc
    If Not (avdoc Is Nothing) Then
        Set PDDoc = avdoc.GetPDDoc
        Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
        If SaveDialogBox.Show = -1 Then
            OutputFolder = SaveDialogBox.SelectedItems(1)
        End If
        PDDoc.Save 1, OutputFolder & "\" & FName
    End If
    'Close pdf file without saving
    AcroApp.GetActiveDoc.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

 

[prati]

Hey,
My friends have tried your code and it works great.
However, it doesn't work for me. I do not have adobe acrobat pro, I have just adobe reader free version.
Maybe there is a way to make changes to your code and use that function which open the pdf, but doesn't prompt the user to "save as"

Function OpenPDFPage(PDFPath As String, PageNumber As Long, PageView As Integer)

ThisWorkbook.FollowHyperlink PDFPath, NewWindow:=True

End Function


Sub OpenPdf()

On Error Resume Next
OpenPDFPage "C:\Temp\Article.pdf", 115, 2

'Page view options:
'0: Full Page
'1: Zoom to 100%
'2: Page Width

End Sub

It just open a pdf file....

 

[Zot]

Hey,
My friends have tried your code and it works great.
However, it doesn't work for me. I do not have adobe acrobat pro, I have just adobe reader free version.
Maybe there is a way to make changes to your code and use that function which open the pdf, but doesn't prompt the user to "save as"

Function OpenPDFPage(PDFPath As String, PageNumber As Long, PageView As Integer)

ThisWorkbook.FollowHyperlink PDFPath, NewWindow:=True

End Function


Sub OpenPdf()

On Error Resume Next
OpenPDFPage "C:\Temp\Article.pdf", 115, 2

'Page view options:
'0: Full Page
'1: Zoom to 100%
'2: Page Width

End Sub

It just open a pdf file....

but the line
wb.FollowHyperlink SourcePath & FName

will open the workbook even without Acrobat since it is VBA code I believe. Only the saving part is Adobe. I will need to be back in office on Tuesday to test on PC without Acrobat but readers only.

 

[Zot]

Sorry for late reply. I was on long weekend from 4th to 7th and rushing on job on the 8th. Then again taking leave on 9th

I was overthinking on the task. Actually, I do not need to open file since the main objective is to move saved files from one location to another location, right?

Opening pdf file might require Windows API to handle the file I guess. the simpler method is just to ask where you want to move the file. Try the code below:

Sub MovePDFFiles()

Dim Answer As Long
Dim Fname As String
Dim SourceFolder As String
Dim TargetFolder As String
Dim FSO As Object
Dim MyFile As Object

'Path of the folder where files are locted
SourceFolder = "D:\Test\"                       ' Set your folder path here
TargetFolder = "C:\Users\yourusername\Desktop\macro\Final\New\Target_Folder\"
          
Set FSO = CreateObject("Scripting.FileSystemObject")

'Check if Source Folder exists
If FSO.FolderExists(SourceFolder) = True Then
    'Looping through each file in the Source Folder
    For Each MyFile In FSO.GetFolder(SourceFolder).Files
        Fname = FSO.GetFileName(MyFile)
        Answer = MsgBox("Do you want to move this file" & vbLf & Fname, vbQuestion + vbYesNoCancel)
        Select Case Answer
            Case vbYes
                Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
                If SaveDialogBox.Show = -1 Then
                    TargetFolder = SaveDialogBox.SelectedItems(1)
                    MyFile.Move TargetFolder & "\"
                End If
            Case vbCancel
                Exit Sub
            Case vbNo
        
        End Select
    Next MyFile
Else
    MsgBox "Source Folder does not exist"
End If

End Sub

 

[prati]

Sorry for late reply. I was on long weekend from 4th to 7th and rushing on job on the 8th. Then again taking leave on 9th

I was overthinking on the task. Actually, I do not need to open file since the main objective is to move saved files from one location to another location, right?

Opening pdf file might require Windows API to handle the file I guess. the simpler method is just to ask where you want to move the file. Try the code below:

Sub MovePDFFiles()

Dim Answer As Long
Dim Fname As String
Dim SourceFolder As String
Dim TargetFolder As String
Dim FSO As Object
Dim MyFile As Object

'Path of the folder where files are locted
SourceFolder = "D:\Test\"                       ' Set your folder path here
TargetFolder = "C:\Users\yourusername\Desktop\macro\Final\New\Target_Folder\"
         
Set FSO = CreateObject("Scripting.FileSystemObject")

'Check if Source Folder exists
If FSO.FolderExists(SourceFolder) = True Then
    'Looping through each file in the Source Folder
    For Each MyFile In FSO.GetFolder(SourceFolder).Files
        Fname = FSO.GetFileName(MyFile)
        Answer = MsgBox("Do you want to move this file" & vbLf & Fname, vbQuestion + vbYesNoCancel)
        Select Case Answer
            Case vbYes
                Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
                If SaveDialogBox.Show = -1 Then
                    TargetFolder = SaveDialogBox.SelectedItems(1)
                    MyFile.Move TargetFolder & "\"
                End If
            Case vbCancel
                Exit Sub
            Case vbNo
       
        End Select
    Next MyFile
Else
    MsgBox "Source Folder does not exist"
End If

End Sub

Hey,
Very nice job indeed.
I wonder whether It is possible to make small changes giving the possibility to rename the files during the process. In another words, not only moving them to another folder but also to rename the files.

 

[Zot]

Try this

Sub MovePDFFiles2()

Dim Fname As String
Dim NameIn As String
Dim SourceFolder As String
Dim TargetFolder As String
Dim FSO As Object
Dim MyFile As Object
Dim oFolder As Object

'Path of the folder where files are located
SourceFolder = "D:\Test\"                       ' Set your folder path here
          
Set FSO = CreateObject("Scripting.FileSystemObject")

'Check if Source Folder exists
If FSO.FolderExists(SourceFolder) = True Then
    Set oFolder = FSO.GetFolder(SourceFolder)
    'Looping through each file in the Source Folder
    If oFolder.Files.Count = 0 Then
        MsgBox "No file found"
        Exit Sub
    End If
    For Each MyFile In FSO.GetFolder(SourceFolder).Files
        Fname = FSO.GetFileName(MyFile)
        Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
        If SaveDialogBox.Show = -1 Then
            TargetFolder = SaveDialogBox.SelectedItems(1)
            NameIn = InputBox("File to move/save into" & vbLf & TargetFolder, "SAVE/MOVE FILE", Fname)
            MyFile.Move TargetFolder & "\"
            Name TargetFolder & "\" & Fname As TargetFolder & "\" & NameIn
        End If
    Next MyFile
Else
    MsgBox "Source Folder does not exist"
End If

End Sub