I have Excel VBA code that sends data to a word template (saves a docx and pdf file).
The code then sends the pdf as an email via outlook.
It all works perfectly on my local drive, but opening, checking and saving folders and files to sharepoint has beaten me. I've spent hours searching and experimenting....there seems to be some conflicting ports (mainly on other forums).
Surely I'm not alone here....
Code that works on my local drive is:
thefilepath = Application.ActiveWorkbook.Path
Set wrdDoc = wrdApp.Documents.Open(thefilepath & "\Letter Template.docx", ReadOnly:=True)
strFolderPath = thefilepath & "\Results"
CheckDir (strFolderPath)
<Run code>
wrdDoc.SaveAs thefilepath & "\Results\" & thefilename & ".doc"
wrdDoc.ExportAsFixedFormat OutputFileName:=thefilepath & "\Results\" & thefilename & ".pdf", ExportFormat:=wdExportFormatPDF
Function CheckDir(Path As String)
If Dir(Path, vbDirectory) = "" Then
MkDir (Path)
End If
End Function
Problems…
Thefilepath is not accurate…..returns “C:\Users\sf\PP\WIP\a Macros”
I’m struggling to create the “results” subfolder
Docx and PDF naming is giving me errors.
My excel file is in
thisdir = https://pplanners.sharepoint.com/sites/PP/Shared Documents/PP WIP/a Macros
I want to save my docx and pdf files to thisdir & "/results" Ie.
resultsdir = https://pplanners.sharepoint.com/sites/PP/Shared Documents/PP WIP/a Macros/results
So to test if the results subdirectory exists I've tried....
If Dir("/pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/results", vbDirectory) = "" Then
If Dir("//pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/results", vbDirectory) = "" Then
If Dir("https://pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/results", vbDirectory) = "" Then
But nothing seems to work
Similarly, for MkDir, I’ve tried
MkDir "https://pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
MkDir "//pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
MkDir "/pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
MkDir "https://pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
MkDir "//pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
MkDir "/pplanners.sharepoint.com/sites/PP/Shared%20Documents/PP%20WIP/a%20Macros/Results"
Handy code that I’ve used to tweak name so far is:
tr = ThisWorkbook.Path
tr2 = Replace(Replace(tr, "http:", ""), "/", "\")
tr3 = Replace(tr2, " ", "%20")
Hoping to get some discussion going on file and folder management with sharepoint.
Related
I've been running into issues for a while with trying to save Excel files in new folders. I think that it's connected to OneDrive folders trying to sync, but I can't find anything that helps confirm this issue. I've included a sample piece of code that replicates the issue I've had. If I run this once (creating a new folder), then I will get a SaveAs error. But if I immediately run it again, it will just ask to overwrite the file and it will save just fine. Is there a way to go about handling the save as error or to continue to try until it's saved successfully?
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder"
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
new_book.SaveAs Filename:=folder_path & "\Test Book", FileFormat:=51
End Sub
EDIT: I was able to find a potential workaround, although I haven't done much yet to test it. This file is still being saved to the folder, so I can close the file that gives the save error, and then just reopen it (here also setting it as the same Workbook object for reuse.
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder " & Format(Now, "HHMMSS")
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
book_name = folder_path & "\Test Book " & Format(Now, "HHMMSS")
On Error GoTo savehandler
new_book.SaveAs Filename:=book_name, FileFormat:=51
Exit Sub
savehandler:
new_book.Close
Set new_book = Workbooks.Open(book_name)
End Sub
I am working in a project of VBA, and I need to open some Workbooks, but the name is kind of dynamic, but only the last name. Sometimes the name comes like "OnHand 066 May" and sometimes with "OnHand 006 Jun"
Dim Dir As String
Dir = ActiveWorkbook.Path
Do not use Dir as a variable name. It is a reserved function name.
Use a wildcard with the Dir function to find a file that matches.
The Dir function will not return a full path, so you have to append it again if you want to actually open the file.
Let's assume there is only one file in that folder that matches, as you did not specify that in your question.
Dim sFile As String
sFile = Dir(ActiveWorkbook.Path & "\OnHand*.xls*")
If sFile <> "" Then
' if you get an error on the next line, someone else may have it open already
Debug.Print "About to open: " & ActiveWorkBook.Path & "\" & sFile
WorkBooks.Open ActiveWorkBook.Path & "\" & sFile
Else
MsgBox "Cannot find a file like that"
End If
I have a vba syntax which search for only pdf files.I wanted to know what changes do I need to make in the below code so that it can search docx and similar ext files as well.
If pfile <> "" And Right(pfile, 3) = "pdf" Then
Set obMail = Outlook.CreateItem(olMailItem)
First change your Dir command to look for folder & "\*.*. While you've neglected to incude that important postion of your code, a Dir list isn't going to return anything that is outside of its file mask. Next, pull the file extension off the right hand end and compare it to a list of desired file extensions.
dim folder as string, pfile as string, ext as string
folder = "c:\temp"
pfile = Dir(folder & "\*.*")
do while cbool(len(pfile))
ext = chr(32) & lcase(trim(right(replace(pfile, chr(46), space(99)), 99))) & chr(32)
if cbool(instr(1, " pdf docx doc xls xlsx ", ext, vbTextCompare)) then
'do something with the matching file
end if
pfile = Dir
loop
good afternoon all,
i am using the following code on my spreadsheet to save the file in a specific folder with a specific format:
Const csPath As String = "C:\Stationery Orders\"
MyName = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=csPath & Sheets("Stationery").Cells(1, 1) & Format(CStr(Now), "ddmmyyyy_hhmm") & " " & MyName & ".xlsm", FileFormat:=52
my problem is that i can't find a way to create this folder C:\Stationery Orders\ if the folder doesn't exist and also paste a shortcut on the user's desktop. Is that even possible? any ideas?
kind regards
Put a check before doing SaveAs. Something like,
If Dir(csPath, vbDirectory) = "" Then MkDir csPath
Then do the SaveAs
Try this. It will check if folder exists and create it if it doesn't exist.
Sub MyCuteSub()
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists("C:\temp\temptemptemp") Then
FSO.CreateFolder ("C:\temp\temptemptemp")
End If
End Sub
I have a spreadsheet that upon clicking a button will duplicate itself by copying/pasting everything to a new workbook and save the file with a name that is dependent upon some variable values (taken from cells on the spreadsheet).
My current goal is to get it to save the sheet in different folders depending on the name of client name (cell value held in variable), while this works on the first run, I get an error after.
The code checks if the directory exists and creates it if not.
This works, but after it is created, running it a second time throws the error:
Runtime Error 75 - path/file access error.
My code:
Sub Pastefile()
Dim client As String
Dim site As String
Dim screeningdate As Date
screeningdate = Range("b7").Value
Dim screeningdate_text As String
screeningdate_text = Format$(screeningdate, "yyyy\-mm\-dd")
client = Range("B3").Value
site = Range("B23").Value
Dim SrceFile
Dim DestFile
If Dir("C:\2013 Recieved Schedules" & "\" & client) = Empty Then
MkDir "C:\2013 Recieved Schedules" & "\" & client
End If
SrceFile = "C:\2013 Recieved Schedules\schedule template.xlsx"
DestFile = "C:\2013 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx"
FileCopy SrceFile, DestFile
Range("A1:I37").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\2013 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx", UpdateLinks:= _
0
Range("A1:I37").PasteSpecial Paste:=xlPasteValues
Range("C6").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
You'll have to excuse my lack of knowledge in this area, I am still learning.
I have a very strong feeling it has something to do with the directory checking logic, as when the error is thrown the MkDir line is highlighted.
To check for the existence of a directory using Dir, you need to specify vbDirectory as the second argument, as in something like:
If Dir("C:\2013 Recieved Schedules" & "\" & client, vbDirectory) = "" Then
Note that, with vbDirectory, Dir will return a non-empty string if the specified path already exists as a directory or as a file (provided the file doesn't have any of the read-only, hidden, or system attributes). You could use GetAttr to be certain it's a directory and not a file.
Use the FolderExists method of the Scripting object.
Public Function dirExists(s_directory As String) As Boolean
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
dirExists = oFSO.FolderExists(s_directory)
End Function
To be certain that a folder exists (and not a file) I use this function:
Public Function FolderExists(strFolderPath As String) As Boolean
On Error Resume Next
FolderExists = ((GetAttr(strFolderPath) And vbDirectory) = vbDirectory)
On Error GoTo 0
End Function
It works both, with \ at the end and without.
I ended up using:
Function DirectoryExists(Directory As String) As Boolean
DirectoryExists = False
If Len(Dir(Directory, vbDirectory)) > 0 Then
If (GetAttr(Directory) And vbDirectory) = vbDirectory Then
DirectoryExists = True
End If
End If
End Function
which is a mix of #Brian and #ZygD answers. Where I think #Brian's answer is not enough and don't like the On Error Resume Next used in #ZygD's answer
If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If
This is the cleanest way... BY FAR:
Public Function IsDir(s) As Boolean
IsDir = CreateObject("Scripting.FileSystemObject").FolderExists(s)
End Function
You can replace WB_parentfolder with something like "C:\". For me WB_parentfolder is grabbing the location of the current workbook.
file_des_folder is the new folder i want. This goes through and creates as many folders as you need.
folder1 = Left(file_des_folder, InStr(Len(WB_parentfolder) + 1, file_loc, "\"))
Do While folder1 <> file_des_folder
folder1 = Left(file_des_folder, InStr(Len(folder1) + 1, file_loc, "\"))
If Dir(file_des_folder, vbDirectory) = "" Then 'create folder if there is not one
MkDir folder1
End If
Loop