CODEWITHSUNDEEP
excelvbadirectory
10101
10101

Reputation: 2402

Check if folder exists and save two sheets in there VBA Excel

I need VBA to check if folder with name "Secret_information" already exists. If folder already exists then I need to save PDF and Excel from Worksheet (1) to this folder with special name (see VBA below). If folder does not exists then create new folder in the same direction my opened Excel file is already located. I have made VBA but it doesn't work correctly. Now it doesn't create xls file only pdf. Also this code creates folder to Desktop, I need it to create folder inside folder my opened Excel file is located. How to make it work?

Sub CommercialPart()
   Dim NewPath As String
   NewPath = Application.ThisWorkbook.Path & "" & "Secret_information"
   If Dir(NewPath, 63) = "" Then MkDir NewPath

        ActiveWorkbook.Sheets(1).Select
        ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=NewPath & "\Secret_information_" & [Pricelist!E2] & "_" & "SC" & [Technical!I11] & "_" & Date & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=No, _
        OpenAfterPublish:=False

        ActiveWorkbook.Sheets(1).Copy
        ActiveWorkbook.SaveAs NewPath & "\Secret_information_" & [Pricelist!E2] & "_" & "DD" & [Material!J8] & "_" & Date
        ActiveWorkbook.Close
End Sub

Upvotes: 1

Views: 374

Answers (1)

cyboashu
cyboashu

Reputation: 10433

  1. you are missing \ in Application.ThisWorkbook.Path & "" & "Secret_information" so it should be Application.ThisWorkbook.Path & "\" & "Secret_information"
  2. you are missing extension at the end of this line , also format the date, its more readable that way ActiveWorkbook.SaveAs NewPath & "\Secret_information_" & [Pricelist!E2] & "_" & "DD" & [Material!J8] & "_" & Date it should be ActiveWorkbook.SaveAs NewPath & "\Secret_information_" & [Pricelist!E2] & "_" & "DD" & [Material!J8] & "_" & Format(Date,"ddmmmyy" )& ".xls",xlExcel8

Add the file format for xls as xlExcel8

Upvotes: 1

Related Questions