Code:
Option Compare Database
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Code:
Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String
Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
BrowseFolder = F.Items.Item.path
End If
End Function
Code:
Private Sub Label_Click()
On Error GoTo Label_Click_Err
Dim FName As String
FName = BrowseFolder(Caption:="Select A Folder", InitialFolder:="C:\")
If FName = vbNullString Then
Debug.Print "No folder selected."
Else
Debug.Print "Folder Selected: " & FName
End If
If Right(FName, 1) = "\" Then
Sbj = FName & "Label for RMA " & RMA & ".pdf"
Else
Sbj = FName & "\Label for RMA " & RMA & ".pdf"
End If
DoCmd.OutputTo acOutputReport, "RRMAInfo_Label", acFormatPDF, Sbj, , , , 0
Label_Click_Exit:
Exit Sub
Label_Click_Err:
MsgBox Error$
Resume Label_Click_Exit
End Sub