Shell32 error

[swenger]

I can't remember where but I found the following code online to allow me to choose a folder to save a report in PDF to which has been working for atleast the past 6 months and suddenly stops with an error. Anyone able to help me figure out how to correct it.

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

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

[RuralGuy]

Do you have a MISSING Reference?

[swenger]

Not that I am aware of. Sorry the screen shot is inaccurate. The code was Shell32. I changed it to Shell64 thinking perhaps it had to do with 64 Bit windows vs 32 but didn't make a difference.

[RuralGuy]

You have not referenced the Shell32.dll yet. Your code is not complete.

[RuralGuy]

For example, here's another piece of code that does similar functions:

Option Compare Database
Option Explicit

'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

[swenger]

I think there is something else that is wrong. Because here is another VBA which also suddenly stopped working for email.

[swenger]

If I use the code above, what would I put after calling the function.

Dim FName As String
FName = BrowseFolder

With my code I used the following
FName = BrowseFolder(Caption:="Select A Folder", InitialFolder:="C:")

[RuralGuy]

Would you post a picture of your References, please?

[swenger]

This is the code in my module

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

Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String

End Function

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

This is the code on my formPrivate 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

As mentioned earlier. This has been working for a year and nothing that I can think of has changed.

[RuralGuy]

The code you posted should have a compile error.

[RuralGuy]

If you are going to post code then please copy and paste *all* of the code and use code tags to preserve the formatting. You invoke code tags by pressing the octothorp "#" button toolbar for the response.

[swenger]

I am not sure what you mean by *all*. I posted the code that was relevant to my question being the Function in the module and then the Function being called on the form. If I posted all my code from my database there would be hundreds of lines.

As for as the compile error, yes there is an error which I posted above and this is what i am trying to figure out why this error is now and it wasn't there previously and how to fix it.

Thanks,

[RuralGuy]

For example:

Function BrowseFolder(Optional Caption As String, _
    Optional InitialFolder As String) As String

    End Function

The above code "End Function" is in the wrong place or extra.

[swenger]

Sorry that was a mistake. What happened is that I had extra lines which were remmed with an '

When I removed one, Access automatically inserted the End Function, but this was not in my code or related to my errors. I had removed that when I noticed that Access inserted it but forgot to remove it after I had already pasted it in to my response to the post earlier.

[RuralGuy]

Your two procedures should begin with Sub or Function and end with End Sub or End Function. They don't and that's one of the things I was referring to when I said *all* of the code.