MkDir code returning error 75 on some computers but not others

[Derek]

Good Day All

I am using the code below to check is a folder exists on the user's desktop and if not then create it. Then I am exporting the active sheet as a PDF to that folder.

Code works perfectly on my computer and also on others in my office. However when the file is emailed to our subsidiary companies, this code returns an error 75 cannot locate file.

Each user may have a different environment (network or whatever) so I am trying to avoid a specific directory by using the path to their desktop.

This is the only code I know, but it is obviously encountering an issue.

Please can someone tell me if there is a problem with this code or its syntax and also if there a way I can avoid this issue with alternative code/s. Is there a better code to find the path to the user's desktop?

Any assistance is greatly appreciated. Thanks to all for your help.

Derek

Code:
Sub ExportAsPDF()

Application.Run "CheckFolderExists"

Dim Sh As Worksheet
Set Sh = ActiveSheet

Dim STR1 As String
STR1 = ActiveSheet.Range("D1").Value

Sh.Name = STR1

ActiveSheet.ExportAsFixedFormat xlTypePDF, Environ("Userprofile") & "\Desktop\SERVICE SHEET PDF\" & Sh.Name & ".pdf"

End Sub
____________________________________________________________________________________________________________________________


Sub CheckFolderExists()


Dim strFolderName As String
Dim strFolderExists As String

Environ ("Userprofile") & "\Desktop\"

strFolderName = Environ("Userprofile") & "\Desktop\SERVICE SHEET PDF"

strFolderExists = Dir(strFolderName, vbDirectory)

If strFolderExists = "" Then

cOb = CreateObject("wscript.shell").specialfolders("Desktop") & "\" & "SERVICE SHEET PDF" '--->Change folder name to suit.

MkDir cOb

Else: Exit Sub

End If

End Sub

 

[Anthony47]

In Sub CheckFolderExists, instead of using strFolderName = Environ("Userprofile") & "\Desktop\SERVICE SHEET PDF" try using

strFolderName = CreateObject("wscript.shell").specialfolders("Desktop") & "\SERVICE SHEET PDF"

 

[Jimmypop]

Hi There

See if below will maybe work also?

Sub ExportAsPDF()
   Application.Run "CheckFolderExists"
    Dim strFolderName As String
    Dim Sh As Worksheet
    Dim STR1 As String
    Set Sh = ActiveSheet
    STR1 = ActiveSheet.Range("D1").Value
    Sh.Name = STR1
    strFolderName = GetDesktop() & "\SERVICE SHEET PDF\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolderName & "" & Sh.Name, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Sub CheckFolderExists()
    Dim strFolderName As String
    Dim strFolderExists As String
    strFolderName = GetDesktop() & "\SERVICE SHEET PDF\"
    strFolderExists = Dir(strFolderName, vbDirectory)
    If strFolderExists = "" Then
        cOb = CreateObject("wscript.shell").SpecialFolders("Desktop") & "\" & "SERVICE SHEET PDF" '--->Change folder name to suit.
        MkDir cOb
        Else: Exit Sub
    End If
End Sub
Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

 

[Derek]

Thank you Anthony47 and Jimmypop for your time and help. I will try them both and see if they solve the issue for me. I will post again to let you know how it turns out. Thanks again to you both, and to anyone else who might contribute.

 

[Derek]

Hi There

See if below will maybe work also?

Sub ExportAsPDF()
   Application.Run "CheckFolderExists"
    Dim strFolderName As String
    Dim Sh As Worksheet
    Dim STR1 As String
    Set Sh = ActiveSheet
    STR1 = ActiveSheet.Range("D1").Value
    Sh.Name = STR1
    strFolderName = GetDesktop() & "\SERVICE SHEET PDF\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolderName & "" & Sh.Name, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Sub CheckFolderExists()
    Dim strFolderName As String
    Dim strFolderExists As String
    strFolderName = GetDesktop() & "\SERVICE SHEET PDF\"
    strFolderExists = Dir(strFolderName, vbDirectory)
    If strFolderExists = "" Then
        cOb = CreateObject("wscript.shell").SpecialFolders("Desktop") & "\" & "SERVICE SHEET PDF" '--->Change folder name to suit.
        MkDir cOb
        Else: Exit Sub
    End If
End Sub
Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

Thank you so much guys, I used both your suggestion and they both did the trick. I am very grateful for your help. Keep Happy and have a great day.
Derek

 

[Jimmypop]

Thank you so much guys, I used both your suggestion and they both did the trick. I am very grateful for your help. Keep Happy and have a great day.
Derek

Pleasure and glad we could help...thanks for the feedback...