VBA code to prompt user to select file folder but still keep the file name...

[mulan571]

Hello

I created a vba so I can select several files to print into separate pdf forms and automatically save them to a specific folder. Is there a way I can code it differently so another person can use the file and have the ability to change the file path and still able to print in batches and keep the file names?

Here is a copy of the code I'm using:

Sub PrintUsingDatabase()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myCustomer As Variant

Set FormWks = Worksheets("2016 VRI Form")
Set Form4T = Worksheets("2016 4T Form")
Set FormSC = Worksheets("2016 SC Form")
Set DataWks = Worksheets("2016 VRI Data")

myCustomer = Array("A6")

With DataWks
'first row of data to last row of data in column D
Set myRng = .Range("E5", .Cells(.Rows.Count, "E").End(xlUp))
End With

For Each myCell In myRng.Cells
With myCell
'if the row is not marked, do nothing
If IsEmpty(.Offset(0, -3)) Then

'if print 4 tier customer
ElseIf InStr(.Offset(0, -4), "4T") Then
.Offset(0, -3).ClearContents 'clear mark for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
Form4T.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate


Form4T.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\muthr\sales\Volume Rebate Calculator\VR Calculator\2016 VRI Reports\Individual PDF Files\" & myCell.Value & " " & Format(Date, "mm-dd-yyyy")

lOrders = lOrders + 1

'if print Special Customer
ElseIf InStr(.Offset(0, -4), "SC") Then
.Offset(0, -3).ClearContents 'clear makr for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
FormSC.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate
FormSC.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\muthr\sales\Volume Rebate Calculator\VR Calculator\2016 VRI Reports\Individual PDF Files\" & myCell.Value & " " & Format(Date, "mm-dd-yyyy")

lOrders = lOrders + 1

'print for standard VRI form
Else
.Offset(0, -3).ClearContents 'clear mark for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
FormWks.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate 'just in case

'after testing, change to Preview to False to Print
FormWks.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\muthr\sales\Volume Rebate Calculator\VR Calculator\2016 VRI Reports\Individual PDF Files\" & myCell.Value & " " & Format(Date, "mm-dd-yyyy")

lOrders = lOrders + 1
End If
End With
Next myCell

MsgBox lOrders & " orders were printed."

End Sub

Any help would be greatly appreciated!

[mdmackillop]

Hi
Try the following. I've indicated the rows I changed. You also have undeclared variables (not fixed)

Option Explicit


Sub PrintUsingDatabase()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myCustomer As Variant
Dim Pth As String


'@@@@@@@@@@@@@@@@@@@
Pth = "\\muthr\sales\Volume Rebate Calculator\VR Calculator\2016 VRI Reports\Individual PDF Files\"
Pth = BrowseForFolder(Pth)




Set FormWks = Worksheets("2016 VRI Form")
Set Form4T = Worksheets("2016 4T Form")
Set FormSC = Worksheets("2016 SC Form")
Set DataWks = Worksheets("2016 VRI Data")


myCustomer = Array("A6")


With DataWks
'first row of data to last row of data in column D
Set myRng = .Range("E5", .Cells(.Rows.Count, "E").End(xlUp))
End With


For Each myCell In myRng.Cells
With myCell
'if the row is not marked, do nothing
If IsEmpty(.Offset(0, -3)) Then


'if print 4 tier customer
ElseIf InStr(.Offset(0, -4), "4T") Then
.Offset(0, -3).ClearContents 'clear mark for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
Form4T.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate


'@@@@@@@@@@@@@@@@@@@
Form4T.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pth & myCell.Value & " " & Format(Date, "mm-dd-yyyy")


lOrders = lOrders + 1


'if print Special Customer
ElseIf InStr(.Offset(0, -4), "SC") Then
.Offset(0, -3).ClearContents 'clear makr for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
FormSC.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate
'@@@@@@@@@@@@@@@@@@@
FormSC.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pth & myCell.Value & " " & Format(Date, "mm-dd-yyyy")


lOrders = lOrders + 1


'print for standard VRI form
Else
.Offset(0, -3).ClearContents 'clear mark for the next time
For iCtr = LBound(myCustomer) To UBound(myCustomer)
FormWks.Range(myCustomer(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate 'just in case


'after testing, change to Preview to False to Print
'@@@@@@@@@@@@@@@@@@@
FormWks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pth & myCell.Value & " " & Format(Date, "mm-dd-yyyy")


lOrders = lOrders + 1
End If
End With
Next myCell


MsgBox lOrders & " orders were printed."


End Sub


'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

[snb]

or ?

Sub M_snb()
    With Application.FileDialog(4)
       If .Show Then
           c00 = .SelectedItems(1)
        
            For Each it In Array("2016 VRI Form", "2016 4T Form", "2016 SC Form", "2016 VRI Data")
               Sheets(it).ExportAsFixedFormat 0, c00 & "\" & it & ".pdf"
            Next
        End If
    End With
End Sub