none
Creating pdf file from excel worksheet and save file in a macro created folder. RRS feed

  • Question

  • Hi I have 3 worksheets and I want to conditionally convert them into a pdf file and than save said file into a folder that the macro will create if not already existing and name it with content of cell A1. So my question is if it is possible to do that with the following program?

    Thanks.

    Sub PrintStuff()
        Dim vShts As Variant
        Dim strFileName As String
    
        vShts = Sheets(1).Range("A1")
        If Not IsNumeric(vShts) Then
            Exit Sub
        Else
            ' Change path and filename as desired
            strFileName = "C:\MyFolder\MySubfolder\MyFile.pdf"
            If strFileName <> "False" Then
                Select Case vShts
                    Case 1
                        Sheets("Sheet1").Select
                    Case 2
                        Sheets("Sheet2").Select
                    Case 3
                        Sheets(Array("Sheet1", "Sheet2")).Select
                End Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=strFileName, _
                    OpenAfterPublish:=False
            End If
        End If
    End Sub



    • Edited by JKicker Friday, March 6, 2015 12:32 AM
    Friday, March 6, 2015 12:27 AM

Answers

  • Option Explicit
    
    Sub PrintStuff()
      Dim Path As String, FileName As String
      Dim ThisSheet As Variant
      Dim MySheets As Variant
     
      Path = "C:\MyFolder\MySubfolder\"
      FileName = "MyFile.pdf"
     
      If Not FolderCreate("C:\MyFolder\MySubfolder") Then
        MsgBox "Can not create folder"
        Exit Sub
      End If
     
      Select Case Range("A1")
        Case 1
          Set MySheets = Sheets("Sheet1")
        Case 2
          Set MySheets = Sheets("Sheet2")
        Case 3
          Set MySheets = Sheets(Array("Sheet1", "Sheet2"))
        Case Else
          MsgBox "Uuups."
          Exit Sub
      End Select
     
      Set ThisSheet = ActiveSheet
      MySheets.Select
      ActiveSheet.ExportAsFixedFormat xlTypePDF, Path & FileName, OpenAfterPublish:=False
      ThisSheet.Select
    End Sub
    
    Private Function FolderCreate(ByVal Path As String) As Boolean
      'Creates a complete sub directory structure
      Dim Temp, i As Integer
      On Error GoTo ExitPoint
      If Dir(Path, vbDirectory) = "" Then
        If Right$(Path, 1) = "\" Then Path = Left$(Path, Len(Path) - 1)
        If Left$(Path, 2) = "\\" Then
          i = InStr(3, Path, "\")
          Temp = Split(Mid$(Path, i + 1), "\")
          Temp(0) = Left$(Path, i) & Temp(0)
        Else
          Temp = Split(Path, "\")
        End If
        Path = ""
        For i = 0 To UBound(Temp)
          Path = Path & Temp(i) & "\"
          If Dir(Path, vbDirectory) = "" Then MkDir Path
        Next
      End If
      FolderCreate = True
    ExitPoint:
    End Function
    
    


    • Edited by Andreas Killer Friday, March 6, 2015 11:21 AM
    • Marked as answer by JKicker Saturday, March 7, 2015 12:39 AM
    Friday, March 6, 2015 11:20 AM

All replies

  • Option Explicit
    
    Sub PrintStuff()
      Dim Path As String, FileName As String
      Dim ThisSheet As Variant
      Dim MySheets As Variant
     
      Path = "C:\MyFolder\MySubfolder\"
      FileName = "MyFile.pdf"
     
      If Not FolderCreate("C:\MyFolder\MySubfolder") Then
        MsgBox "Can not create folder"
        Exit Sub
      End If
     
      Select Case Range("A1")
        Case 1
          Set MySheets = Sheets("Sheet1")
        Case 2
          Set MySheets = Sheets("Sheet2")
        Case 3
          Set MySheets = Sheets(Array("Sheet1", "Sheet2"))
        Case Else
          MsgBox "Uuups."
          Exit Sub
      End Select
     
      Set ThisSheet = ActiveSheet
      MySheets.Select
      ActiveSheet.ExportAsFixedFormat xlTypePDF, Path & FileName, OpenAfterPublish:=False
      ThisSheet.Select
    End Sub
    
    Private Function FolderCreate(ByVal Path As String) As Boolean
      'Creates a complete sub directory structure
      Dim Temp, i As Integer
      On Error GoTo ExitPoint
      If Dir(Path, vbDirectory) = "" Then
        If Right$(Path, 1) = "\" Then Path = Left$(Path, Len(Path) - 1)
        If Left$(Path, 2) = "\\" Then
          i = InStr(3, Path, "\")
          Temp = Split(Mid$(Path, i + 1), "\")
          Temp(0) = Left$(Path, i) & Temp(0)
        Else
          Temp = Split(Path, "\")
        End If
        Path = ""
        For i = 0 To UBound(Temp)
          Path = Path & Temp(i) & "\"
          If Dir(Path, vbDirectory) = "" Then MkDir Path
        Next
      End If
      FolderCreate = True
    ExitPoint:
    End Function
    
    


    • Edited by Andreas Killer Friday, March 6, 2015 11:21 AM
    • Marked as answer by JKicker Saturday, March 7, 2015 12:39 AM
    Friday, March 6, 2015 11:20 AM
  • Thank you!! Thank you very much.

    But is it possible that it will name the folder or search for the folder name with the data in cell E1 for example. Or is it allready there but I just cant see it and I am very new to this still.

    -John

    Friday, March 6, 2015 3:40 PM
  • Thank you!! Thank you very much.

    But is it possible that it will name the folder or search for the folder name with the data in cell E1 for example. Or is it allready there but I just cant see it and I am very new to this still.

    -John

    Change

    FileName = "MyFile.pdf"

    To

    FileName = Range("E1").Value


    Friday, March 6, 2015 5:57 PM