Error 1004 saving chart as PDF

[colts4u]

I've been hammering my head trying to figure out why I keep getting an Error 1004 when I run this sub to save chart as a PDF. The error says "Document nor saved. The document may be open, or an error may have been encountered when saving." I've stepped through it several times and have made some changes, but nothing seems to work. The folder exists, so I don't think it has to do with it not being found. Here's the code...

Sub SaveChartAsPDF()
On Error GoTo err_handler
'Create and assign variables
Dim saveLocation As String
Dim strTestFolder As String
Dim strTestName As String
Dim strEvent As String
Dim strCycleCount As String
Dim cht As Chart
Charts(1).Activate
strTestFolder = "C:\Users\username\OneDrive - Carrier Corporation\Current Inspections\"
'strTestFolder = "C:\Users\username\Documents\PDF Favorites\" 'Tried saving local
strTestName = Worksheets("DataHistory").Range("A1")
strEvent = Worksheets("DataHistory").Range("C1")
strCycleCount = Worksheets("DataHistory").Range("B1")
saveLocation = strTestFolder & strTestName & "\" & strTestName & "_" & strCycleCount & "_" & strEvent & ".pdf"
'Charts(1).Activate
Set cht = Charts(1)
'Save a chart as PDF
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
exit_handler:
    Exit Sub
err_handler:
    MsgBox "Error " & Err.Number & Chr(13) & Chr(10) & Err.Description, vbExclamation, "Whoops, it didn't save as PDF! :("
    Resume exit_handler
End Sub

 

[colts4u]

I believe I have narrowed it down to the subfolder causing the error. If I save to the location "C:\Users\username\OneDrive - Carrier Corporation\Current Inspections\", omitting the subfolder within this folder, it work okay. Debug print of the location looks like this "C:\Users\bact1hd\OneDrive - Carrier Corporation\Current Inspections\RT727(31)_186530cycles_Test Fault.pdf". Any idea why there would be a problem saving to a subfolder?

 

[colts4u]

For now, removing the subfolder in the path gets my sub to work. I will have to manually move the PDF within the appropriate folder, but it's better than nothing LOL. Since I have to move the file manually, I added the shell command to open the folder where the file is saved. Here's the code...

Sub SaveChartAsPDF()
On Error GoTo err_handler
Dim saveLocation As String
Dim strPath As String
Dim strFilename As String
Dim cht As Chart
'Set file and folder names and locations
strFilename = Worksheets("DataHistory").Range("A1") & "_" & Worksheets("DataHistory").Range("B1") & "_" & Worksheets("DataHistory").Range("C1") & ".pdf"
strPath = "C:\Users\username\OneDrive - Carrier Corporation\Current Inspections\"
saveLocation = strPath & strFilename
Set cht = Charts(1)
'Save a chart as PDF
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
Call Shell("explorer.exe" & " " & strPath, vbNormalFocus)
exit_handler:
    Exit Sub
err_handler:
    MsgBox "Error " & Err.Number & Chr(13) & Chr(10) & Err.Description, vbExclamation, "Whoops, it didn't save as PDF! :("
    Resume exit_handler
End Sub

 

[colts4u]

If someone knows how to properly handle subfolders using a name string from a cell, please post up.

 

[Grasor]

Option Explicit

Sub SaveChartAsPDF()
On Error GoTo err_handler
'Create and assign variables
Dim saveLocation As String
Dim strTestFolder As String
Dim strTestName As String
Dim strEvent As String
Dim strCycleCount As String

Dim cht As Chart
Charts(1).Activate

strTestFolder = "C:\Upload\"
'strTestFolder = "C:\Users\username\Documents\PDF Favorites\" 'Tried saving local
strTestName = Worksheets("DataHistory").Range("A1")
strEvent = Worksheets("DataHistory").Range("C1")
strCycleCount = Worksheets("DataHistory").Range("B1")
saveLocation = strTestFolder & strTestName & "\" & strTestName & "_" & strCycleCount & "_" & strEvent & ".pdf"

'Charts(1).Activate
'Set cht = Charts(1) 'This was done earlier in the code.

'**************
'***New Code***
'**************
Dim sDirectory As String
Dim sFilePath As String
Dim sFileName As String 'Always good to breakout the filename from filepath in case this portion needs to be changed.
Dim sResponse As String
'Dim tgtWorksheet As Variant 'This option works as well then set tgtWorksheet = ActiveWorkbook.Activesheet

Set cht = ActiveWorkbook.ActiveChart


sDirectory = strTestFolder & strTestName
sFileName = strTestName & "_" & strCycleCount & "_" & strEvent & ".pdf"

TryAgain:

sFilePath = strTestFolder & strTestName & "\" & sFileName

'Check if Folder path exists.

If checkFolderExists(sDirectory) = False Then 'Folder doesn't exist.
    MkDir (sDirectory) 'So make it.
End If

If checkFileExists(sFilePath) = True Then 'File exists at this location already.
    sResponse = MsgBox("File already exists!  Overwrite?", vbYesNoCancel, "Overwrite existing file?")
    
    If sResponse = vbNo Then 'Offer to rename file.
        sFileName = Application.InputBox("Enter new filename: ", "New Filename", sFileName)
        GoTo TryAgain
    ElseIf sResponse = vbCancel Then
        Exit Sub
    End If
End If

'Save it
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=sFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False


'******************
'***End new code***
'******************
       
exit_handler:
    Exit Sub
err_handler:
    MsgBox "Error " & Err.Number & Chr(13) & Chr(10) & Err.Description, vbExclamation, "Whoops, it didn't save as PDF! :("
    Resume exit_handler
End Sub

Private Function checkFolderExists(sDirectory As String) As Boolean

    Dim objFSO As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    If objFSO.folderexists(sDirectory) = True Then 'Folder exists already.
        checkFolderExists = True
    Else
        checkFolderExists = False
    End If

End Function

Private Function checkFileExists(sFullPath As String) As Boolean

    Dim objFSO As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    If objFSO.FileExists(sFullPath) = True Then 'File exists at location.
        checkFileExists = True
    Else
        checkFileExists = False
    End If
    
End Function

You have to check to see if the directory exists, then make it if it doesn't, in order for subfolders to work. Keep the functions I added to the code in your toolkit for this purpose going forward. I added one to check for the directory, then another to check to see if the file existed already.

I had some difficulty working with your cht variable. Excel refused to Export to PDF the way you had it set. I had to change it to

 Set cht = Charts(1)

to

Set cht = Activeworkbook.ActiveChart

There's a nuance here that a "Chart Object" is any chart in the workbook, whether or not it's its own tab. Whereas ActiveChart is treated more like ActiveSheet and you can print it that way.

 

[colts4u]

Option Explicit

Sub SaveChartAsPDF()
On Error GoTo err_handler
'Create and assign variables
Dim saveLocation As String
Dim strTestFolder As String
Dim strTestName As String
Dim strEvent As String
Dim strCycleCount As String

Dim cht As Chart
Charts(1).Activate

strTestFolder = "C:\Upload\"
'strTestFolder = "C:\Users\username\Documents\PDF Favorites\" 'Tried saving local
strTestName = Worksheets("DataHistory").Range("A1")
strEvent = Worksheets("DataHistory").Range("C1")
strCycleCount = Worksheets("DataHistory").Range("B1")
saveLocation = strTestFolder & strTestName & "\" & strTestName & "_" & strCycleCount & "_" & strEvent & ".pdf"

'Charts(1).Activate
'Set cht = Charts(1) 'This was done earlier in the code.

'**************
'***New Code***
'**************
Dim sDirectory As String
Dim sFilePath As String
Dim sFileName As String 'Always good to breakout the filename from filepath in case this portion needs to be changed.
Dim sResponse As String
'Dim tgtWorksheet As Variant 'This option works as well then set tgtWorksheet = ActiveWorkbook.Activesheet

Set cht = ActiveWorkbook.ActiveChart


sDirectory = strTestFolder & strTestName
sFileName = strTestName & "_" & strCycleCount & "_" & strEvent & ".pdf"

TryAgain:

sFilePath = strTestFolder & strTestName & "\" & sFileName

'Check if Folder path exists.

If checkFolderExists(sDirectory) = False Then 'Folder doesn't exist.
    MkDir (sDirectory) 'So make it.
End If

If checkFileExists(sFilePath) = True Then 'File exists at this location already.
    sResponse = MsgBox("File already exists!  Overwrite?", vbYesNoCancel, "Overwrite existing file?")
   
    If sResponse = vbNo Then 'Offer to rename file.
        sFileName = Application.InputBox("Enter new filename: ", "New Filename", sFileName)
        GoTo TryAgain
    ElseIf sResponse = vbCancel Then
        Exit Sub
    End If
End If

'Save it
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=sFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False


'******************
'***End new code***
'******************
      
exit_handler:
    Exit Sub
err_handler:
    MsgBox "Error " & Err.Number & Chr(13) & Chr(10) & Err.Description, vbExclamation, "Whoops, it didn't save as PDF! :("
    Resume exit_handler
End Sub

Private Function checkFolderExists(sDirectory As String) As Boolean

    Dim objFSO As Object
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    If objFSO.folderexists(sDirectory) = True Then 'Folder exists already.
        checkFolderExists = True
    Else
        checkFolderExists = False
    End If

End Function

Private Function checkFileExists(sFullPath As String) As Boolean

    Dim objFSO As Object
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    If objFSO.FileExists(sFullPath) = True Then 'File exists at location.
        checkFileExists = True
    Else
        checkFileExists = False
    End If
   
End Function

You have to check to see if the directory exists, then make it if it doesn't, in order for subfolders to work. Keep the functions I added to the code in your toolkit for this purpose going forward. I added one to check for the directory, then another to check to see if the file existed already.

I had some difficulty working with your cht variable. Excel refused to Export to PDF the way you had it set. I had to change it to

 Set cht = Charts(1)

to

Set cht = Activeworkbook.ActiveChart

There's a nuance here that a "Chart Object" is any chart in the workbook, whether or not it's its own tab. Whereas ActiveChart is treated more like ActiveSheet and you can print it that way.

Thanks! I will try these changes and see if I can get it to work.

 

[colts4u]

This worked great, thank you! The functions were a welcomed addition. In 95% of the times this would be used, the test folder would already exist, but the next changes were going to be to add in the ability to create the test folder. Really appreciate that.

I went ahead and removed the 'Chart(1).Activate' since the chart variable worked better using 'ActiveWorkbook.ActiveChart'. Looking at the code, it looks like my problem might have been that I was only defining the test folder and not the complete location of the folder. Does that sound correct?

Here's my updated code that I no have on the ribbon toolbar.

Sub SaveDataHistoryChartAsPDF()
On Error GoTo err_handler
Dim strTestFolder As String
Dim strTestName As String
Dim strEvent As String
Dim strEventDate As String
Dim strCycleCount As String
Dim cht As Chart

strTestFolder = "C:\Users\username\OneDrive - Corporate Corporation\Current Inspections\"
strTestName = Worksheets("DataHistory").Range("A1")
strEvent = Worksheets("DataHistory").Range("C1")
strCycleCount = Worksheets("DataHistory").Range("B1")
strEventDate = Sheets("DataHistory").Range("D1")

ActiveWorkbook.ActiveChart.Activate

'**************
'***New Code***
'**************
Dim sDirectory As String
Dim sFilePath As String
Dim sFileName As String 'Always good to breakout the filename from filepath in case this portion needs to be changed.
Dim sResponse As String
'Dim tgtWorksheet As Variant 'This option works as well then set tgtWorksheet = ActiveWorkbook.Activesheet

Set cht = ActiveWorkbook.ActiveChart

sDirectory = strTestFolder & strTestName
sFileName = strTestName & "_" & strCycleCount & "_" & strEvent & "_" & strEventDate & ".pdf"

TryAgain:

sFilePath = strTestFolder & strTestName & "\" & sFileName

'Check if Folder path exists.
If checkFolderExists(sDirectory) = False Then 'Folder doesn't exist.
    MkDir (sDirectory) 'So make it.
End If
If checkFileExists(sFilePath) = True Then 'File exists at this location already.
    sResponse = MsgBox("File already exists!  Overwrite?", vbYesNoCancel, "Overwrite existing file?")    
    If sResponse = vbNo Then 'Offer to rename file.
        sFileName = Application.InputBox("Enter new filename: ", "New Filename", sFileName)
        GoTo TryAgain
    ElseIf sResponse = vbCancel Then
        Exit Sub
    End If
End If
'Save it
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=sFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
exit_handler:
    Exit Sub
err_handler:
    MsgBox "Error " & Err.Number & Chr(13) & Chr(10) & Err.Description, vbExclamation, "Whoops, your chart didn't save!"
    Resume exit_handler
End Sub

 

[Grasor]

Essentially when working with directories you have to make sure the path exists and if it doesn't create it first using MKDIR. When you stated it worked without the subfolder and I saw that the DIR and MKDIR methods were missing that was an immediate clue as to what was going on. The 'chart tab' issue took a bit to puzzle out since I hadn't tried doing this myself before.

It's a common mistake to try to just save files using the export method and specifying a path without creating it first and there really isn't much in the way of feedback when it doesn't work. You just have to know that this step is required. Glad the code helped.