Hi,
The below code breakdown:
creates a pdf of 2 tabs ('Total' & active sheet)
creates a new folder
names the new folder based on the cell B4 value and stores the pdf in the folder location where the excel was launched from.
FYI, Cell B4 is a date value.
What I would like it to do is, Read the cell value in the cell B4 and go 1 step back in the folder location the excel was launched from and match month & year of cell B4 with the folders, open that matched folder and create a new folder, save the pdf in there.
For example: If the excel is launched from P:\INFORMATION TECHNOLOGY\Non-Public\08 2019\Test
I want the code to read the B4 value, let's say if its 08/01/2019, It should match MM & YYYY of B4 cell with the folders in P:\INFORMATION TECHNOLOGY\Non-Public\ and find a matched folder, open it and save the pdf in there.
In this case it will be P:\INFORMATION TECHNOLOGY\Non-Public\08 2019
Sub SaveasPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = wbA.ActiveSheet
'Select 'total' and the active sheet
Sheets(Array("total", wsA.Name)).Select
'Name of the Excel to pdf file - TSYS ISOS
If wbA.Name Like "copy*" Then
strName = Mid(wbA.Name, 5, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
Else
strName = Left(wbA.Name, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
End If
'Select 'total' and the active sheet
Sheets(Array("total", wsA.Name)).Select
'Name of the Excel to pdf file - Trisource ISOS
If wbA.Name Like "copy*" Then
strName = Mid(wbA.Name, 5, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
Else
strName = Left(wbA.Name, 9) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
End If
'Create a daily folder under today's date
strPath = wbA.Path & "" & Format(wsA.Range("B4").Value, "MM-D-YYYY")
If Dir(strPath, vbDirectory) = "" Then MkDir (strPath)
strPathFile = strPath & "" & strName
'Export to PDF in the folder created under today's date
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
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
The below code breakdown:
creates a pdf of 2 tabs ('Total' & active sheet)
creates a new folder
names the new folder based on the cell B4 value and stores the pdf in the folder location where the excel was launched from.
FYI, Cell B4 is a date value.
What I would like it to do is, Read the cell value in the cell B4 and go 1 step back in the folder location the excel was launched from and match month & year of cell B4 with the folders, open that matched folder and create a new folder, save the pdf in there.
For example: If the excel is launched from P:\INFORMATION TECHNOLOGY\Non-Public\08 2019\Test
I want the code to read the B4 value, let's say if its 08/01/2019, It should match MM & YYYY of B4 cell with the folders in P:\INFORMATION TECHNOLOGY\Non-Public\ and find a matched folder, open it and save the pdf in there.
In this case it will be P:\INFORMATION TECHNOLOGY\Non-Public\08 2019
Sub SaveasPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = wbA.ActiveSheet
'Select 'total' and the active sheet
Sheets(Array("total", wsA.Name)).Select
'Name of the Excel to pdf file - TSYS ISOS
If wbA.Name Like "copy*" Then
strName = Mid(wbA.Name, 5, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
Else
strName = Left(wbA.Name, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
End If
'Select 'total' and the active sheet
Sheets(Array("total", wsA.Name)).Select
'Name of the Excel to pdf file - Trisource ISOS
If wbA.Name Like "copy*" Then
strName = Mid(wbA.Name, 5, 10) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
Else
strName = Left(wbA.Name, 9) & " " & Format(wsA.Range("B4").Value, "MM-DD-YYYY") & ".pdf"
End If
'Create a daily folder under today's date
strPath = wbA.Path & "" & Format(wsA.Range("B4").Value, "MM-D-YYYY")
If Dir(strPath, vbDirectory) = "" Then MkDir (strPath)
strPathFile = strPath & "" & strName
'Export to PDF in the folder created under today's date
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
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub