Previous Topic Next Topic

Modified code create subfolder and save as pdf to it based on cell

Solved/Closed
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022 - Sep 20, 2020 at 07:04 AM
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 - Sep 29, 2020 at 11:16 AM
hi, all
i need help to amend my code actually the code works very well but i need some adjusting i would create subfolders based on h2 then save as pdf file name based on i2 so the file pdf will save to subfolder based on h2 then when i run macro every time if the subfolder name is existed then just copy to file name to existed subfolder if not existed then create a new subfolder based on h2 and save the file to it and if i run macro a gain to save file name to subfolder and the same file is existed then gives me message if i replace the file or not 
Sub SavePDF()
    ChDir "C:\Users\OSE\Downloads\client\" & ActiveSheet.Range("H2").Value & "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveSheet.Range("i2") _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
End Sub

thanks
Related:

1 reply

Answer 1 / 1
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Updated on Sep 22, 2020 at 12:02 PM
Hi Abdel,

Here you go: 
Sub RunMe()
Dim mPath, mPathFile As String
Dim oW As Long

mPath = "C:\Users\OSE\Downloads\client\" & ActiveSheet.Range("H2").Value & "\"
mPathFile = mPath & ActiveSheet.Range("I2").Value

If Dir(mPath, vbDirectory) = vbNullString Then
    MkDir mPath
    GoTo sFile
End If

If CBool(Len(Dir$(mPathFile & ".pdf")) > 0) = True Then
    oW = MsgBox("Overwrite existing file?", vbQuestion + vbYesNo, "File Exists")
    If oW = vbYes Then
        GoTo sFile
    Else
        Exit Sub
    End If
Else
    GoTo sFile
End If
Exit Sub

sFile:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mPathFile _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub


NOTE: I did assume you don't have the ".pdf" extention added to your filename in cell I2. If you do, then remove the "& ".pdf" part on code line 13.

Best regards,
Trowa

0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Updated on Sep 26, 2020 at 09:54 AM
many thanks ,Trowa it works so well can you add message box if cell h2 or i2 are empty then show message "you have to fill names subfolder and file "? i noted it gives me error if are two or one of them empty
thanks again
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523 > abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Sep 28, 2020 at 11:52 AM
Hi Abdel,

Good to hear!

To prevent the missing data error, paste the piece of code between code line 3 and 5: 
If Range("H2").Value = vbNullString And Range("I2").Value = vbNullString Then
    MsgBox "You have to enter subfolder and file names.", vbInformation, "Missing names"
    Range("H2:I2").Select
    Exit Sub
ElseIf Range("H2").Value = vbNullString Then
    MsgBox "You have to enter subfolder name.", vbInformation, "Missing name"
    Range("H2").Select
    Exit Sub
ElseIf Range("I2").Value = vbNullString Then
    MsgBox "You have to enter file name.", vbInformation, "Missing name"
    Range("I2").Select
    Exit Sub
End If


Best regards,
Trowa
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022 > TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022
Sep 28, 2020 at 03:39 PM
astonishing updating i appreciate your assistance the code has become more efficient thanks for every thing
best regards,
abdelfattah
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523 > abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Sep 29, 2020 at 11:16 AM
Awesome Abdel! Thanks for the kind feedback!
0