vba save as pdf into a shared folder with different computer - vba

Hi I wrote a code where it saves the excel sheet as PDF file into a our company's sharefolder (dropbox). I realized when my coworker tried to use that Macro, it doesn't work because of the path the file is saved.
in the code, where it says "MyComputerName" is what my computer name and i am guessing it's because my co workers computer name is different so it can't find the path on her computer.
Is there a way to solve this? so we both can use this macro and save it into the shared folder ?
Help!!!
Sub SaveAsPDF()
' FormatName
ActiveSheet.Name = "#" & ActiveSheet.Range("F6").Value & " " & ActiveSheet.Range("F4").Value
' saveAsPDF Macro
ActiveSheet.ExportAsFixedFormat Type:=xltypepdf, Filename:= _
"C:\Users\MyComputerName\Dropbox\Team Folder\PACKING LIST\201804\" & "PACKING LIST_" & ActiveSheet.Name _
, quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

Try adding the following lines to the beginning of your code:
Dim username As String
username = Environ$("username")
And then your path should be:
"C:\Users\" & username & "\Dropbox\...
To make the year/month dynamic (assuming based on today's date), your link can be:
...LIST\" & Format(Now(), "yyyymm") & "\PACKING LIST...

Related

Detect PDF file in folder and also check if it is open

I need codes for below. As I try to find in this website, but nothing match my need. So please if anybody write some codes.
It should search a file in a folder and file name should be taken from cell whatever file name I type for search and if it is open it should warn me that file is open. The file will be in PDF format.
File shall not be duplicate if it find duplicate it shall show me warning REPLACE or NO.
If it is not a duplicate than save as PDF taking whatever name I write in cells and there will 2 different cells.
Option Explicit
Function FileExists(FullFileName As String) As Boolean
FileExists = Len(Dir(FullFileName)) > 0
End Function
Sub SaveAsPDF()
Dim nResult As Long
Dim fName As String
Const fPath As String = "C:\Users\KYD\Desktop\"
With ActiveSheet
fName = .Range("A1").Value & " " & Range("J1").Value & ".pdf"
If Not FileExists(fPath & fName) Then
MsgBox prompt:="PDF file saved." & vbNewLine & "Location <> C:\Users\KYD\Desktop\", _
Buttons:=vbOKOnly + vbInformation, Title:="Thanks"
.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
fPath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Else:
nResult = MsgBox(prompt:="PDF file already exit do you want to overwrite a previous file check in below given folder." _
& vbNewLine & "Location <> C:\Users\KYD\Desktop\", Buttons:=vbYesNo + vbCritical, Title:="MME")
If nResult = vbYes Then
.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
fPath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
Exit Sub
End If
End With
End Sub
i try to write these codes which export pdf and take name from cells and check if the file exited in folder ask user to replace or no.
i need some codes in it which can also check if the file is open taking name from cells. if it is opened show message the file is open else nothing.

Automatically Save File as Text With Friday's Date

I recorded a macro that at the end saves the workbook as a text file and closes.
I would like to change the file name to Friday's date so that every week when I save it, the file name is different.
This is what the macro recorded
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\username\Desktop\Temp\\File2218.txt" _
, FileFormat:=xlText, CreateBackup:=False
I tried to change it to
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\username\Desktop\Temp\File" & Text(Today()+2, "mdyy")& txt" _
, FileFormat:=xlText, CreateBackup:=False
(The reason I did +2 is because it's always done one Wed, therefore +2 = Friday)
But it doesn't work.
Any help would be greatly appreciated!
Does the C:\Users\username folder actually exist? You will probably have to change username to your own username, or use Environ$("Username") like this:
"C:\Users\" & Environ$("Username") & "\Desktop\Temp\File"
And make sure the folder exists too, or you will get another error.
Also, use DateAdd() to add days:
NewDate = DateAdd("d", 2, Date)
And Format$() to format it (Text() is more of a worksheet function)
Once completed, you end up with this:
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\" & Environ$("Username") & "\Desktop\Temp\File" & _
Format$(DateAdd("d", 2, Date), "mdyy") & ".txt" _
, FileFormat:=xlText, CreateBackup:=False

Macro to export Excel Doc as PDF for all Users

I need to create a macro that will save an excel document as a PDF file to any user's desktop (i.e. multiple people will be using this document/macro).
Here is VBA code I have so far:
Sub CreatePDF()
'
' CreatePDF Macro
'
'
ChDir "C:\Users\Public\Desktop"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Public\Desktop\QuickView Update Dec_2017.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
I think the issue is with the directory it's saving to (in the instances where this code says "Public" in the file path, I had changed that from my username which was initially populated).
Does anyone know a way to specify a generic path to save this document as a PDF to any users' desktop?
Use .specialfolders("Desktop") to save to the desktop. Set to a string variable and add the path separator
Example
Option Explicit
Sub CreatePDF()
Dim FilePath As String
FilePath = CreateObject("WScript.Shell").specialfolders("Desktop")
Debug.Print FilePath
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FilePath & "\" & "QuickView Update Dec_2017.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
The following special folders are available:
AllUsersDesktop
AllUsersStartMenu
AllUsersPrograms
AllUsersStartup
Desktop
Favorites
Fonts
MyDocuments
NetHood
PrintHood
Programs
Recent
SendTo
StartMenu
Startup
Templates
The SpecialFolders property returns an empty string if the requested folder (strFolderName) is not available. For example, Windows 95 does not have an AllUsersDesktop folder and returns an empty string if strFolderNameis AllUsersDesktop.
Here is another example
https://stackoverflow.com/a/31694603/4539709
You can use environment variables. %USERPROFILE%\Desktop should work in this instance.
Here's a list of environment variables. https://en.wikipedia.org/wiki/Environment_variable#Default_Values
Accessing environment variables with VBA: Environ Function code samples for VBA
In VBA you could translate it to Environ("USERPROFILE") & "\Desktop" This is untested as I'm not using Windows.
I have not tested this but based on what you gave try :
Dim url As String
url = Application.DefaultFilePath & "\" & ActiveWorkbook.Name & ".xls"
in your export part of your code replace filename:= blah blah to Filename:=url

Save as PDF and Excel 2016 Copy In Folder and Filename created from Cell Value

I'm working with Excel 2016, I have created a Template with a main Sheet(G-Card) and the following 3 sheets get the information from the first sheet.
I have a Macro that allows me to save all 4 sheets into PDF creating a Folder in a specific location and saving it under that folder using cell values. I have also manage to save the workbook as a copy under the same filename in the same folder but it says that it is not compatible or extension error.
The only extension that seems to work is .xlm. I need to be able to save the template as a PDF and as an Excel file in the same folder including the macro in the 2016 version. Help please.. here is my code:
Sub NewFolder_SaveasPDF_CLICK()
Dim strFilename As String
Dim FldrName As String
On Error Resume Next
Set rngRANGE = Worksheets("G-Card").Range("U3")
FldrName = Worksheets("G-Card").Range("O4").Value
strFilename = rngRANGE.Value & " "
MkDir "Q:\Green Cards & Acknowledgement\Green Cards & Acknowledgement\2017 Orders\" & FldrName
Sheets(Array("G-Card", "P-AKG", "W-AKG", "Y-AKG")).Select Sheets("G-Card").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"Q:\Green Cards & Acknowledgement\Green Cards & Acknowledgement\2017 Orders\" & FldrName & "\" & strFilename & Worksheets("G-Card").Range("O4").Value & ".pdf" _
, QUALITY:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True _
Dim ExcelWork As String
ExcelWork = strFilename & FldrName
ActiveWorkbook.SaveAs FileName:="Q:\Green Cards & Acknowledgement\Green Cards & Acknowledgement\2017 Orders\" & FldrName & "\" & ExcelWork & ".xlm", _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Save multiple worksheets as PDF

I'm fairly green with using VBA and this is the first time I've posted a question in this forum so bear with me if I'm breaking any posting rules.
Below is a piece of code I use to print/save 1 or more worksheets from an Excel workbook to PDF. It works fine if the data from each worksheet that I'm exporting fits onto a single page. The problem I'm finding is that if the range of data from my first sheet is larger than 1 page then only the 1st worksheet will be exported, and only up to the first page-break. Any advice or suggestions on how I can resolve this issue?
'Ask user if report needs to be saved as a pdf
PdfCheck = MsgBox("Save report as PDF", vbYesNo, "Save PDF")
'use result of <PdfCheck> to control if statement
If PdfCheck = vbYes Then
Pdfsheets = InputBox("How many worksheets would you like to include in PDF")
'Prints the number of sheets entered by user
'starts at first ACTIVE Worksheet to the result of <Pdfsheets>
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\" & WinName & "\Documents\REPORTING\" & Database & "\" & _
ReportYear & "\" & FolderMonth & "\" & Database & "-" & Title & "-" & FileDate _
, Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=Pdfsheets, OpenAfterPublish:=True
Else
GoTo X
End If
X:
End Sub
The method I use, is to loop through the worksheets within the workbook and select the ones that meet my criteria. Then I use ExportAsFixedFormat to create my pdf.
Note you cannot select hidden worksheets, so if the workbook contains them you will need to add an if/then to check visibility.
Pdfsheets = InputBox("How many worksheets would you like to include in PDF")
for x=1 to Pdfsheets
thisworkbook.sheets(x).select (false) 'use false to select multiple sheets
next x
'Prints the number of sheets entered by user--starts at first ACTIVE
Worksheet to the result of <Pdfsheets>
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\" & WinName & "\Documents\REPORTING\" & Database & "\" & ReportYear & "\" & FolderMonth & "\" & Database & "-" & Title & "-" & FileDate _
, Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True