I am trying to save file macro to my teams one drive. This is a shift report with multiple users that I want to put a "save a copy" button on so when we hit save it creates a pdf in a folder on our drive that is Timestamped with Date, Shift, and Supervisor. Below is what I've been able to get from a tutorial website. I have the URL for the share drive folder I want these to end up in. I need some help figuring out where to plug it in at. Right now when I run the macro it will create a prompt with the file name and where it was saved to. The location looks correct, but when I got to check that location on the SharePoint the file is non existent.
Thanks in advance,
Chris
``Sub PDFActiveSheetNoPrompt()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("B1").Value _
& " - " & wsA.Range("B2").Value _
& " - " & wsA.Range("B3").Value
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
'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
exitHandler:
Exit Sub
errHandler`:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I have tried plugging the URL from https....to the "/" following the last location into the file path in the declaration of "StrPath", and into both "wbA" and "path" on wbA.Path. I'm not sure what else I can change the code to in this macro without causing an error somewhere else.
The easiest way is to make the target folder available in your One Drive app then use the local path to save the file.
Related
I have a nice working PDF export VBA that I use to export a sheet in Excel.
The problem is that the title of the Workbook also is the title of the exported PDF.
I cannot seem to change the title upon export and I cannot find a working solution for this.
The titlename has to be dynamic as this will change for each export.
The filename can be different from titlename.
Image found on internet shows the difference. It is the title property that I want to change.
My export code shown below.
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
Dim ary
Dim a As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\Monthly reports\"
strName = wsA.Range("V4").Value & "-" & wsA.Range("W4").Value & " " & wsA.Range("C5").Value _
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
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
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If
'Select sheets to use
ary = Array(Sheet5.Name)
For Each a In ary
Sheets(a).Move after:=Sheets(Sheets.Count)
Next a
ThisWorkbook.Sheets(ary).Select
'export to PDF in current folder
ActiveSheet.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
https://www.contextures.com/excelvbapdf.html
The following is perfect, but it prints the entire sheet.
full thread
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
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 myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use 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")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
but I'm having trouble with this
'export to PDF if a folder was selected
If myFile <> "False" Then
` wsA.ExportAsFixedFormat
Type:=xlTypePDF,
Filename:=myFile,
Quality:=xlQualityStandard,
IncludeDocProperties:=True,
IgnorePrintAreas:=False,
OpenAfterPublish:=False`
The only thing I'm trying to accomplish is print a range (Preferably named) in lieu of the entire sheet. I created dims and set a range to use in lieu of the 'wsA' Sheet and it is bugging.
Dim rnG As Range
Set rnG = Range("Y1:AG46")
rnG.ExportAsFixedFormat _
Are the only lines that I've added. It'll work as I want it, but intermittently and I've got no idea why. It bugs in yellow the entire ExportFileAsFixedFormat subtext and points to not recognizing the specified Range.
I suspect this is because you are not qualifying the range. Try
Set rnG = wsA.Range("Y1:AG46")
Without qualification works correctly only if wsA is the active sheet.
My code runs perfectly when I save to my local drive, but when I save to the shared drive I get Runtime Error 5? How is this occurring?
I have unmerged cells and put it as center across selection
Ensured that the whole document is within the print margins
Edit: I have tried saving into the folder directory above where I was saving and it works. I understand that there is a character limit (pathname and title), which might be the problem? Is there a way to solve this?
The error is in the following area:
'Creating Only the PDF based on Company Network - there is an existing folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
This is the whole code:
Option Explicit
Private Function selectfolder()
'Defining the Variables
Dim user_name As String
user_name = Environ("username") 'to pick up the username from work environment
'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)
End With
End Function
Sub SaveActiveSheetAsPDF()
'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub
'Defining the Type of Variables
Dim inputrange As Range 'Range represents a cell or multiple cells in Excel
Dim cell As Range
Dim network, Address, Fldr, Title As String
'If user does not choose a folder
Address = selectfolder
If Address = "" Then
Exit Sub
End If
'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)
For Each cell In inputrange
Range("G2").Value = cell.Value
'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"
'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
End If
Next cell
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"
End Sub
It is difficult to diagnose problems with network drive without more information, but I could suggest a workaround instead.
You could save the file on your local drive and then move it using the File System Object in VBA. Here's how it would look like:
'Save Active Sheet as PDF in temporary folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Environ("TEMP") & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Move PDF to Company network drive
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.MoveFile Environ("TEMP") & "\" & Title & ".pdf", Fldr & "\" & Title & ".pdf"
Note that for this code to work, you need a reference to the Microsoft Scripting Runtime Library.
I have code which works fine in windows 7 and other windows version environments, but when some of the users have been upgraded to Windows 10 (myself included)
This is a macro enabled sheet which has worked fine for 3 years, and as far as I can tell the only change is the 'upgrade' to windows 10!
this is the bit of code which seems to fail:
'saveas function for pdf
ws.range("A1:K69").ExportAsFixedFormat Type:=xlTypePDf, _
filename:=path & fname, _
Quality:-xlqualityStandard, _
IncludeDocProperties:=True' _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
I get a Run-Time error Method 'ExportAsFixedFormat' of Object 'Range' failed. But when someone in an earlier windows environment runs the code it works perfectly and I get the pdf created, saved and opened for the user to insert other documents into.
Driving me mental, and I cannot work out why this would fail - and also sporadically as well.
I use the below to auto save an excel sheet as PDF, should try and save it to the excel file location and name it after the tab name.
If you set a print area on the sheet for the range you want to view in the PDF first, it should work :)
Hope it helps
Sub Export_Summary()
'
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 myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'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")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I have a vba excel to pdf code but I am unsure how to loop it through a data validation list. The data validation list is a collection of player names with each selection within the list interacting with vlookup's on the excel sheet. This means that each selection will result in different data pulled onto the sheet. Is there a way to loop and print each individual data selected sheet to a PDF but have all PDF sheets in a single file? The dvCell is located in cell C8 of sheet "Gym Weekly Template".
Below is the code I currently have:
Sub PDFActiveSheet()
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 myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Gym Weekly Template")
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use 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")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Much appreciated if you can help!