Sunday, June 21, 2020

Check if a folder exists in a path ,if not create it,then save all the sheets in a workbook in that folder with a name containing workbookname and current time in "yyyymmdd\_hhmmss" format

Option Explicit
Function Path_Exists(Path As String) As String

'Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult

   ' Path = "C:\Users\allso\Desktop\excel_to_pdf"

    Folder = dir(Path, vbDirectory)
' MsgBox (Path)
' MsgBox (Folder)
    If Folder = vbNullString Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer
            Case vbYes
                VBA.FileSystem.MkDir (Path)
            Case Else
                Exit Function
        End Select

    Else

       ' MsgBox "Folder exists."

    End If
   Path_Exists = Path
End Function

Sub vba_excel_to_pdf()
'Path_Exists ("C:\Users\allso\Desktop\excel_to_pdf")
Dim output_file As String, ws_count, I As Integer
'output_file = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".pdf"
'MsgBox (output_file)
'Set the location where the pdfs will be saved

'Dim pdffolder As FileDialog
'
'
'
'
'Set pdffolder = Application.FileDialog(msoFileDialogFolderPicker)
'pdffolder.AllowMultiSelect = False
'pdffolder.Show
'
'
  
Dim dir As String
'dir = pdffolder.SelectedItems(1)
dir = Path_Exists("C:\Users\allso\Desktop\excel_to_pdf")
'MsgBox (dir)
Dim strtime As String


' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dir & "\" & customer_code & ".pdf", openafterpublish:=False
 ' Set WS_Count equal to the number of worksheets in the active
        
         ws_count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To ws_count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
           ' MsgBox ActiveWorkbook.Worksheets(I).Name
          
        strtime = Format(Now(), "yyyymmdd\_hhmmss")
       ' MsgBox (strtime)
           output_file = dir & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "." & ActiveWorkbook.Worksheets(I).Name & "." & strtime & ".pdf"
           'MsgBox (output_file)

           ActiveWorkbook.Worksheets(I).ExportAsFixedFormat xlTypePDF, output_file, xlQualityStandard, openafterpublish:=False
           'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=output_file, openafterpublish:=False

         Next I

End Sub


Source:https://www.contextures.com/excelvbapdf.html

No comments:

Post a Comment