SAVE as PDF has a glitch {pulling hair out}

jeepster0000 · Jan 22, 2019

I am running an excel macro that saves it as a PDF. I want it to pop up with a default file name and ask the user if they want to overwrite it. If they say yes, then overwrite, but if they say no, then they should be prompted to change the file name. It does this, but if the user selects save again, then the file saves automatically without confirming if they want to overwrite it.

It works almost like it is supposed to, but It is doing something weird.

If you click save as, the pdf save as pops up with the default file name GOOD
If you try to overwrite the file a message box appears to verify you want to overwrite GOOD
If you click no to over write, but click save again, the message box does not appear, and it overwrites the file anyways. BAD

I have taken out all loops I was trying so it would not jumble the code up for you.

Here is a copy of the code that is whooping my butt. If you have a sec, could you take a look? I owe you big

Code:

[COLOR=#333333]Sub ExportPDFCheckFile()[/COLOR]
[COLOR=#333333]'contextures dot com for Excel 2010 and later[/COLOR]
[COLOR=#333333]' Code taken from [/COLOR]
[COLOR=#333333]'checks for existing file[/COLOR]
[COLOR=#333333]'prompt to overwrite or rename[/COLOR]
[COLOR=#333333]'uses bFileExists Function, below[/COLOR]

[COLOR=#333333]Dim wsA As Worksheet[/COLOR]
[COLOR=#333333]Dim wbA As Workbook[/COLOR]
[COLOR=#333333]Dim strTime As String[/COLOR]
[COLOR=#333333]Dim strName As String[/COLOR]
[COLOR=#333333]Dim strPath As String[/COLOR]
[COLOR=#333333]Dim strFile As String[/COLOR]
[COLOR=#333333]Dim strPathFile As String[/COLOR]
[COLOR=#333333]Dim strOWcheck As String[/COLOR]
[COLOR=#333333]Dim myFile As Variant[/COLOR]
[COLOR=#333333]Dim lOver As Long[/COLOR]
[COLOR=#333333]On Error GoTo errHandler[/COLOR]

[COLOR=#333333]'Activate Worksheet to save as pdf[/COLOR]
[COLOR=#333333]Sheets("PrintForm").Activate[/COLOR]
[COLOR=#333333]Set wbA = ActiveWorkbook[/COLOR]
[COLOR=#333333]Set wsA = ActiveSheet[/COLOR]

[COLOR=#333333]'Uses time stamp for file name[/COLOR]
[COLOR=#333333]strTime = Format(Now(), "yyyy_mm_dd")[/COLOR]

[COLOR=#333333]'get active workbook folder, if saved[/COLOR]
[COLOR=#333333]strPath = wbA.Path[/COLOR]

[COLOR=#333333]'Puts \ in path[/COLOR]
[COLOR=#333333]If strPath = "" Then[/COLOR]
[COLOR=#333333]strPath = Application.DefaultFilePath[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]strPath = strPath & ""[/COLOR]

[COLOR=#333333]'create default name for savng file[/COLOR]
[COLOR=#333333]strName = Sheets("LockedData").Range("F6").Text[/COLOR]
[COLOR=#333333]strName = Replace(strName, " ", "")[/COLOR]
[COLOR=#333333]strName = Replace(strName, ".", "_")[/COLOR]
[COLOR=#333333]strName = Replace(strName, "/", "")[/COLOR]
[COLOR=#333333]strName = Replace(strName, "&", "-")[/COLOR]

[COLOR=#333333]'create default path for saving[/COLOR]
[COLOR=#333333]strFile = strTime & strName & ".pdf"[/COLOR]
[COLOR=#333333]strPathFile = strPath & strFile[/COLOR]

[COLOR=#333333]'Test if file exsts[/COLOR]
[COLOR=#333333]If bFileExists(strPathFile) Then[/COLOR]
[COLOR=#333333]myFile = Application.GetSaveAsFilename _[/COLOR]
[COLOR=#333333](InitialFileName:=strPathFile, _[/COLOR]
[COLOR=#333333]FileFilter:="PDF Files (*.pdf), *.pdf", _[/COLOR]
[COLOR=#333333]Title:="Select Folder and FileName to save")[/COLOR]

[COLOR=#333333]'pop up box for overwright[/COLOR]


[COLOR=#333333]lOver = MsgBox("Overwrite existing file?", _[/COLOR]
[COLOR=#333333]vbQuestion + vbYesNo, "File Exists")[/COLOR]
[COLOR=#333333]strOWcheck = lOver[/COLOR]
[COLOR=#333333]If lOver <> vbYes Then[/COLOR]

[COLOR=#333333]'user can enter name and[/COLOR]
[COLOR=#333333]' select folder for file[/COLOR]
[COLOR=#333333]myFile = Application.GetSaveAsFilename _[/COLOR]
[COLOR=#333333](InitialFileName:=strPathFile, _[/COLOR]
[COLOR=#333333]FileFilter:="PDF Files (*.pdf), *.pdf", _[/COLOR]
[COLOR=#333333]Title:="Select Folder and FileName to save")[/COLOR]
[COLOR=#333333]If myFile <> "False" Then[/COLOR]
[COLOR=#333333]wsA.ExportAsFixedFormat _[/COLOR]
[COLOR=#333333]Type:=xlTypePDF, _[/COLOR]
[COLOR=#333333]Filename:=myFile, _[/COLOR]
[COLOR=#333333]Quality:=xlQualityStandard, _[/COLOR]
[COLOR=#333333]IncludeDocProperties:=True, _[/COLOR]
[COLOR=#333333]IgnorePrintAreas:=False, _[/COLOR]
[COLOR=#333333]OpenAfterPublish:=False[/COLOR]

[COLOR=#333333]'confirmation message with file info[/COLOR]
[COLOR=#333333]'Activate Worksheet that button was on[/COLOR]
[COLOR=#333333]Sheets("Fill").Activate[/COLOR]
[COLOR=#333333]MsgBox "PDF file has been created: " _[/COLOR]
[COLOR=#333333]& vbCrLf _[/COLOR]
[COLOR=#333333]& myFile[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]GoTo exitHandler[/COLOR]
[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]'export to PDF in current folder[/COLOR]
[COLOR=#333333]wsA.ExportAsFixedFormat _[/COLOR]
[COLOR=#333333]Type:=xlTypePDF, _[/COLOR]
[COLOR=#333333]Filename:=strPathFile, _[/COLOR]
[COLOR=#333333]Quality:=xlQualityStandard, _[/COLOR]
[COLOR=#333333]IncludeDocProperties:=True, _[/COLOR]
[COLOR=#333333]IgnorePrintAreas:=False, _[/COLOR]
[COLOR=#333333]OpenAfterPublish:=False[/COLOR]
[COLOR=#333333]'confirmation message with file info[/COLOR]
[COLOR=#333333]MsgBox "PDF file has been created: " _[/COLOR]
[COLOR=#333333]& vbCrLf _[/COLOR]
[COLOR=#333333]& strPathFile[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]exitHandler:[/COLOR]
[COLOR=#333333]Exit Sub[/COLOR]
[COLOR=#333333]errHandler:[/COLOR]
[COLOR=#333333]'Error Message, that File was not created[/COLOR]
[COLOR=#333333]MsgBox "Could not create PDF file"[/COLOR]
[COLOR=#333333]Resume exitHandler[/COLOR]
[COLOR=#333333]End Sub[/COLOR]

[COLOR=#333333]'=============================[/COLOR]
[COLOR=#333333]Function bFileExists(rsFullPath As String) As Boolean[/COLOR]
[COLOR=#333333]bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)[/COLOR]
[COLOR=#333333]End Function[/COLOR]

John_w · Jan 22, 2019

It's difficult to follow the code without the indentation (post it inside CODE tags), but there is a strange logic: if the file exists, you prompt for another file name, then ask if it should be overwritten! The question should come before the prompt, and ask for another file name only if the user's response is 'No'. All this should be put in a loop until the file doesn't exist or the user's response is 'Yes'. Also, the On Error GoTo errHandler is probably hiding errors in the code and causing the glitch you're seeing, so I would get rid of that line and fix any errors that arise.

jeepster0000 · Jan 22, 2019

I have reposted in code format Thanks for the help

Code:

Sub ExportPDFCheckFile()'contextures dot com for Excel 2010 and later
' Code modified from contextures dot com /excelvbapdf.html
'checks for existing file
'prompt to overwrite or rename
'uses bFileExists Function, below


Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim strOWcheck As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler


'Activate Worksheet to save as pdf
Sheets("PrintForm").Activate
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet


'Uses time stamp for file name
strTime = Format(Now(), "yyyy_mm_dd")


'get active workbook folder, if saved
strPath = wbA.Path


'Puts \ in path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"


'create default name for savng file
strName = Sheets("LockedData").Range("F6").Text
strName = Replace(strName, " ", "")
strName = Replace(strName, ".", "_")
strName = Replace(strName, "/", "")
strName = Replace(strName, "&", "-")


'create default path for saving
strFile = strTime & strName & ".pdf"
strPathFile = strPath & strFile


'Test if file exsts
If bFileExists(strPathFile) Then
    myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")
        
        'pop up box for overwright
         
    
    lOver = MsgBox("Overwrite existing file?", _
      vbQuestion + vbYesNo, "File Exists")
    strOWcheck = lOver
    If lOver <> vbYes Then
      
        'user can enter name and
        ' select folder for file
        myFile = Application.GetSaveAsFilename _
          (InitialFileName:=strPathFile, _
              FileFilter:="PDF Files (*.pdf), *.pdf", _
              Title:="Select Folder and FileName to save")
        If myFile <> "False" Then
            wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
            
            'confirmation message with file info
            'Activate Worksheet that button was on
            Sheets("Fill").Activate
            MsgBox "PDF file has been created: " _
              & vbCrLf _
            & myFile
        Else
          GoTo exitHandler
        End If
      
    End If
    
Else
    'export to PDF in current folder
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
    & vbCrLf _
    & strPathFile
End If
exitHandler:
    Exit Sub
errHandler:
    'Error Message, that File was not created
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub


'=============================
Function bFileExists(rsFullPath As String) As Boolean
  bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function

jeepster0000 · Jan 22, 2019

I know the logic is wierd, I want the file name to be the same almost all the time. It is the user's job to put in the right directory. Each file will be saved in it's own address directory. It is okay for them to overwrite the file, but I do not want them to do it accidentally. Please let me know of a better way to write it. I commented out the exit and errror handler, and I am still getting the same error. I know I must be missing something simple.

Thanks for your help

6StringJazzer · Jan 22, 2019

Cross-posted

Fluff · Jan 22, 2019

@jeepster0000
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

jeepster0000 · Jan 22, 2019

Copy that, I apologize

jeepster0000 · Jan 22, 2019

The Problem was solved. Here is the link. Thank you for all that helped. https://www.excelforum.com/excel-pr...as-a-glitch-pulling-hair-out.html#post5049452

SAVE as PDF has a glitch {pulling hair out}

jeepster0000

New Member

Excel Facts

John_w

MrExcel MVP

jeepster0000

New Member

jeepster0000

New Member

6StringJazzer

Well-known Member

Fluff

MrExcel MVP, Moderator

jeepster0000

New Member

jeepster0000

New Member

Similar threads

Forum statistics

Share this page

SAVE as PDF has a glitch {pulling hair out}

New Member

Excel Facts

MrExcel MVP

New Member

New Member

Well-known Member

MrExcel MVP, Moderator

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock