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:
Modified code create subfolder and save as pdf to it based on cell
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.
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
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
thanks again
- Posts
-
2776
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- July 26, 2021
466 > abdelfatah_0230Good 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 IfBest regards,
Trowa
- Posts
-
69
- Registration date
- Thursday July 18, 2019
- Status
- Member
- Last seen
- January 15, 2021
> TrowaDbest regards,
abdelfattah
- Posts
-
2776
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- July 26, 2021
466 > abdelfatah_0230