here are my codes:
Sub Export()
Dim wsA As Worksheet
Dim wsB As Workbook
Dim strPath As String
Dim strName As String
Dim strPathFile As String
Dim OpenFile
Set wbA = ActiveWorkbook
Set wsA = ActiveWorksheet
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
If strPath = "" Then
strPath = wbA.path
End If
strPath = strPath & "\"
strName = "My Document"
strFile = strName & ".pdf"
strPathFile = strPath & strFile
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard,_
IncludeDocProperties:=True,_
IgnorePrintAreas:=False,_
OpenAfterPublish:=False
appPath = "C:\Program Files\TrackerSoftware\PDFViewer\PDFXCView.exe"
OpenFile = Shell(appPath&" "& strPathFile, vbNormalFocus)
End Sub
My generated PDF could be opened on xchange viewer if i didn't command it to save in desktop. Now it only opens Xchange Viewer without my document :(
Related
Trying to set this code found Here to work recursively down through my folders. at the minute I have this
Public Sub addPassword()
Dim FSO As Object
Dim strFileName As String
Dim strFilePath As String
Dim folder As Object, subfolder As Object
Dim doc As Object
Dim oDoc As Document
Dim PWD As String
Set FSO = CreateObject("Scripting.FileSystemObject")
folderPath = "G:\Test Data"
Set folder = FSO.GetFolder(folderPath)
PWD = "FooBar"
For Each doc In folder.Files
strFilePath = "G:\Test Data\"
strFileName = Dir$(strFilePath & "*.doc*")
Set oDoc = Documents.Open( _
FileName:=strFilePath & strFileName, _
PasswordDocument:="FooBar")
oDoc.Saved = False
oDoc.SaveAs2 FileName:=strFilePath & strFileName, _
Password:=PWD
oDoc.Close
Set oDoc = Nothing
Next
For Each subfolder In folder.SubFolders
For Each doc In subfolder.Files
strFilePath = "G:\Test Data\"
strFileName = Dir$(strFilePath & "*.doc*")
Set oDoc = Documents.Open( _
FileName:=strFilePath & strFileName, _
PasswordDocument:="FooBar")
oDoc.Saved = False
oDoc.SaveAs2 FileName:=strFilePath & strFileName, _
Password:=PWD
oDoc.Close
Set oDoc = Nothing
Next
Next
End Sub
Absolute Novice to vba so trying to use some limited python experience to set this up recursively. I can see every file open up in the side but when I go to check on them non of them have a password set
Any help would be appreciated thank you
Hi guys i'm brand new to coding but i have somehow (haha) managed to export my excel into PDF. Now Im having difficulties trying to have the PDF automatically open in PDF XChange Viewer instead of Adobe Reader.
Here are my codes:
Sub Export()
Dim wsA As Worksheet
Dim wsB As Workbook
Dim strPath As String
Dim myFile As Variant
Set wbA = ActiveWorkbook
Set wsA = ActiveWorksheey
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
myFile = Application.GetSaveAsFilename _
(FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsa.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard,_
IncludeDocProperties:=True,_
IgnorePrintAreas:=False,_
OpenAfterPublish:=True
End If
End Sub
Disclaimer i copied the codes from somewhere online because i wanted to allow users to name the file, select where they save it.
What should i do to open the PDF in PDFXChange Viewer. The directory is: C:\Program Files\Tracker Software\PDF Viewer
As you mentioned you already managed to export to PDF, so try below code to open the PDF file in Adobe Reader In case of PDF XChange Viewer put XChange Viewer exe file path in the code.
Sub OpenPDFbyAdobeReader()
Dim exePath, filePath As String
Dim OpenFile
exePath = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
filePath = "E:\CyberArk\DNA_Datasheet.pdf"
openPath = exePath & " " & filePath
OpenFile = Shell(openPath, vbNormalFocus)
End Sub
Edit
Sub to save as pdf then open in a program.
Sub Export()
Dim wsA As Worksheet
Dim wsB As Workbook
Dim strPath As String
Dim myFile As Variant
Dim appPath As String
Dim OpenFile
Set wbA = ActiveWorkbook
Set wsA = ActiveWorkbook.ActiveSheet
appPath = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
myFile = Application.GetSaveAsFilename _
(FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
OpenFile = Shell(appPath & " " & myFile, vbNormalFocus)
End If
End Sub
You have to replace appPath with your XChange viewer path.
Open PDF in PDFXCview
Below is an example of how to call the application using Shell. You'd need to specify the path/filename of your PDF, and you may need to confirm the location of PDFXCview.exe on your machine.
Sub OpenPDF_test()
Const XCviewPath = "C:\Program Files\Tracker Software\PDF Editor\PDFXCview.exe"
Const pdfFileName = "C:\myPath\myPDFfileName.pdf"
Debug.Print XCviewPath & " """ & pdfFileName & """"
End Sub
PDFXCview.exe Command Line Options
You can also add command line options if you want to automate more advanced tasks.
For example, you could have it:
automatically print and then close the file,
hide the user interface,
import saved settings,
or even run custom JavaScript.
Command Line switches
/A "param=value [¶m2=value [&...]"
/close[:save|discard|ask]
/print[:[default=yes|no][&showui=yes|no][&printer=<printername>][&pages=<pagesrange>]]
/printto[:[default=yes|no][&showui=yes|no][&pages=<pagesrange>]] <printername>
/exportp <setting_file_name>
/importp <setting_file_name>
/RegServer
/UnregServer
/usep <setting_file_name>
More Information Here.
What I have is a workbook with all the sales from all the sales associates in "Sheet", and in the other sheets the sheets are named by the sales person number ("41", "51", "88", etc.) with their sales. What I want the macro to do is take each worksheet and save as a pdf with "worksheet name" & "Filename"
My question is related to this post, but for some reason my version is not saving the pdf's properly.
excel vba - save each worksheet in workbook as an individual pdf
So what I want is simple: take each worksheet and save into it's own unique pdf. The problem I'm having is that the macro is saving each individual sheet with the right filename, but when I open the pdf, its the same sales associate for each pdf.
here is the code:
Option Explicit
Sub WorksheetLoop()
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
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For I = 1 To WS_Count
'replace spaces and periods in sheet name
strName = Replace(wbA.Worksheets(I).Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.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
Next I
End Sub
let me know if you need any additional details
you need to activate Activate each worksheet before you print them into pdf. Try this
' Begin the loop.
For Each wsA In wbA.Sheets
wsA.Activate
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.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
Next
You should first activate each sheet before you export it as PDF. Try:
Option Explicit
Sub WorksheetLoop()
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
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For Each wsA In wbA.Worksheets
wsA.Activate
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.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
Next wsA
End Sub
I have a macro in excel which loops over the tabs and saves the tabs as PDFs in a given folder.
The macro partially works, it creates a few PDFs but then stops and throws this error:
Run Time Error 5 - Invalid Procedure Call or Argument
Here is my code:
Option Explicit
Sub WorksheetLoop()
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
Dim rng As Range
' Prevents screen refreshing.
Application.ScreenUpdating = False
Set wbA = ActiveWorkbook
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For Each wsA In ActiveWorkbook.Worksheets
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
If strName = "Macro" Then
MsgBox "That's all folks! :)"
Exit Sub
End If
If strName = "TOUCHPOINTS" Then
strName = "Touchpoints by markets"
End If
If strName = "VIDEOHOURS" Then
strName = "Viewing Hours by markets"
End If
If strName = "TARGETS" Then
strName = "Shares by markets"
End If
If strName = "SHARESCHANNELS" Then
strName = "IGNORE ME"
End If
If strName = "TOP10PREMIERES" Then
strName = "Top 10 Premieres by markets"
End If
If strName = "SHARETREND" Then
strName = "Share trends last 13 months"
End If
If strName = "COMPETITION" Then
strName = "Share overview international media companies"
End If
If strName = "COMPETITIONSHARETREND" Then
strName = "Share trends factual competitors last 13 months"
End If
If strName = "PUT" Then
strName = "PUT level"
End If
If strName = "CHANNELRANKER" Then
strName = "Top 20 Channels by Market"
End If
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'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
End If
Next wsA
' Enables screen refreshing.
Application.ScreenUpdating = True
End Sub
Probably the error is here:
If myFile <> "False" Then
I guess that it should be simply like this -> If myFile Then or If len(myFile) >8 Then
However, the code looks working. Just try to rebuild it with Select Case, it looks way better and slightly faster:
Select Case strName
Case "Macro"
MsgBox "That's all"
Exit Sub
Case "TOUCHPOINTS"
strName = "Touchpoints by markets"
Case Else
Debug.Print "I don't know -> "; strName
End Select
Probably you will find the error then.
I am trying to create a separate pdf of each sheet in an Excel Workbook. This is the code I am using.
Sub CreatePdfs()
' CreatePdfs Macro
' Keyboard Shortcut: Ctrl+o
Dim ws As Worksheet
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
For Each ws In Worksheets
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strFile = strName & ".pdf"
strPathFile = strPath & strFile
ws.Select
nm = wsA.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next ws
End Sub
This "almost" works. It creates a separate pdf file for each sheet (as it is supposed to) and saves it in the same folder as the Excel file (like it's supposed to) but names it incorrectly. For instance if there are 4 sheets in the workbook named 1, 2, 3, and 4, then it creates sheet 2 as a pdf and names it "1." It names 3 as "2", 4 as "3" and 1 as "4".
I must have something out of order in the code.
If you avoid using .Select then you will not face that problem. You do not need the lines Set wbA = ActiveWorkbook and Set wsA = ActiveSheet. Also ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF... becomes ws.ExportAsFixedFormat Type:=xlTypePDF...
Try this code
Sub CreatePdfs()
' CreatePdfs Macro
' Keyboard Shortcut: Ctrl+o
Dim ws As Worksheet
Dim strPath As String, strFile As String, strPathFile As String
strPath = ThisWorkbook.Path
If strPath = "" Then strPath = Application.DefaultFilePath
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
For Each ws In ThisWorkbook.Worksheets
strName = Replace(Replace(ws.Name, " ", ""), ".", "_")
strFile = strName & ".pdf"
strPathFile = strPath & strFile
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strPathFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next ws
End Sub