I'm trying to upload a local xlsm file to SharePoint online using VBA. The file would auto upload to SharePoint after the user saves the file.
The concept is after the user saves the xlsm file, it would create a new folder with the copied file and upload the copied file in the folder to SharePoint. After upload, the folder would be deleted.
However, I'm unable to save the file to the folder due to
Runtime error 1004
I check the possible reasons, the file name/path do exist, the folder was successfully created.
The file is not being used by another program, only excel runs the file.
The folder is newly created, it an empty folder, does not contain a file with the same name.
I did check all the paths and they are all correct.
This is my code
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim UploadToSharepoint As Boolean
Dim SharePointLib As String
Dim myPath As String
Dim folderPath As String
Dim objNet As Object
Dim FS As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ActiveWorkbook.path
myPath = Application.ActiveWorkbook.FullName
SharePointLib = "https://company.com/folder/subfoler"
copyPath = folderPath + "\copyPath"
MsgBox "This is the folderPath = " & folderPath & vbNewLine & "This is the filepath = " & myPath & vbNewLine & "The copyPath is = " & copyPath
If Not FolderExists(copyPath) Then
FolderCreate (copyPath)
End If
SharePointLib = SharePointLib & FileNameWithExt(myPath)
ThisWorkbook.SaveCopyAs (copyPath)
Exit Sub
loadFailed:
UploadToSharepoint = False
End Sub
Your copyPath is only a folder, but the argument of SaveCopyAs should be a full path with file name.
Try this:
ThisWorkbook.SaveCopyAs copyPath & "\filename.xlsx"
Related
I am trying to open all Excel files (.xlsx) in a specified folder and extract information from each one to add to a master spreadsheet for a report.
I can't open the file. I get a
Run-time error '1004'
saying it couldn't find FILE.xlsx.
The file name is correct and matches the file name and extension (.xlsx).
The last line of the code isn't working.
Dim FileName As String
Dim Folder As String
Dim Month As String
Dim File As Variant
Month = MonthName(CurrentMonth)
Folder = "C:\Users\mpresley\Documents\Other\Ben\Forecast Summary\Forecast"
FolderName = Folder & Month & CurrentYear
Dim firstEmptyRow As Long
Dim attachmentFolder As String, StrFile As String, filenameCriteria As String
Dim attachmentWorkBook As Workbook
Dim copyRngToArray As Variant
'# Set file extension
filenameCriteria = "xlsx"
'set
StrFile = Dir(FolderName & "\*" & filenameCriteria)
Do While Len(StrFile) > 0
Set attachmentWorkBook = Workbooks.Open(StrFile)
Specify both the folder path and the file name:
Set attachmentWorkBook = Workbooks.Open(FolderName & "\" & StrFile)
I want copy target macro to new location:
Dim strDes As String
strDes = "D:\" & ActiveWorkbook.Name
FileCopy ActiveWorkbook.FullName, strDes
it occur error
permission denied
How can copy an Excel file that is open?
You may copy the opened file using Scripting.FileSystemObject
Sub test()
src = ThisWorkbook.FullName
dest = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
CreateObject("Scripting.FileSystemObject").CopyFile src, dest
End Sub
Suppose, we have one folder with only one macro file and every day we are saving excel file in the same folder received via mail. However, filename every day will get changed. I mean to say what ever file we are getting through mail do not have a standard name. Now, we have two files in the same folder.
Can we open another file which we have saved with some random name available in the same folder using a macro? Here, the name of another file is not standard. Additionally, after running a macro, we also want to delete that file.
You can get the filename of the newest file within a directory by this:
Option Explicit
Private Sub GetNewestFilename()
Dim searchDirectory As String
Dim searchPattern As String
Dim currentFilename As String
Dim NewestFilename As String
Dim NewestFiledate As Date
searchDirectory = Application.DefaultFilePath & "\"
searchPattern = "*.xl*"
currentFilename = Dir(searchDirectory & searchPattern, 0)
If currentFilename <> "" Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
Do While currentFilename <> ""
If FileDateTime(searchDirectory & currentFilename) > NewestFiledate Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
End If
currentFilename = Dir
Loop
End If
MsgBox NewestFilename
Dim wb As Workbook
Set wb = Workbooks.Open(searchDirectory & NewestFilename)
' do something
wb.Close SaveChanges:=False
Set wb = Nothing
' Kill searchDirectory & NewestFilename ' Delete the file
End Sub
I have an excel file that when opened needs to download and open the latest version of an add in that is stored in Sharepoint. I have this code that downloads the add in, saves it in a specific location (strSavePath) and tries to open it.
Function funLoadRomeFiles(strURL As String, strSavePath As String)
Dim objConnection As Object
Dim objStream As Object
Set objConnection = CreateObject("MSXML2.ServerXMLHTTP.6.0")
On Error GoTo ExitConnect
objConnection.Open "GET", strURL, False
objConnection.send
strURL = objConnection.responseBody
If objConnection.Status = 200 Then
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1
objStream.Write objConnection.responseBody
objStream.SaveToFile strSavePath, 2
objStream.Close
End If
ExitConnect:
On Error GoTo 0
Shell "C:\WINDOWS\explorer.exe """ & strSavePath & "", vbHide
End Function
However I get an error on the second to last row. The error is: Excel cannot open the file "Filename" because the file format or file extension is not valid [...]". The file downloaded is corrupted and cannot be opened manually either. When I download it and open it manually , it works.
The file size is 30.9 kb, but executing the code will download it as a 51 kb file. I've tried downloading other files using this code, and they have also become corrupted and 51 kb no matter the actual file size. Is there any way to change the code so the file will not be corrupted or any other ways of doing this?
Update: The file downloaded seems to be a html file even though its name still ends with .xlam
Also, I,ve tried using a link that ends with "filename.xlam" and one that ends with "filename.xlam?csf=1&e=b5f7991021ab45c1833229210f3ce810", both gives the same result, and when you copy the links into chrome both immediately downloads the correct file
I had a once a similar Problem.
The Problem by me was, that sharepoint did not allow a certain kind of file Type. So i had to do a workaround. So what you can try is to Zip your *.xlam File and Put that on the Sharepoint. Then you download it with the Code you already have. And then you just unzipped with the Following Code.
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Fname = strSavePath' I assume that this is the Path to the File you Downloaded
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
DefPath = Application.DefaultFilePath 'Or Change it to the Path you want to unzip the Files
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
And after that you just executed the Extension.
I Hope this can help you.
I could not find a way to download to add-ins, tried multiple different way and concluded that there was som authorization error or something else caused by the version of SharePoint I was using. The solution I found that suited my needs was to open the add-ins directly from SharePoint using this code:
On Error Resume Next
ActiveWorkbook.FollowHyperlink Address:="strUrl"
On Error GoTo 0
I download reports on a daily/weekly basis but when downloading the system auto generates the file name with a date at the end although the basic file name is the same. ie ANAPOS - 20141001. I'm using a simple open command (Workbooks.OpenText Filename:="C:\Users\903270\Documents\Excel\ANAPOS.txt") to do some other stuff but before doing so I need to rename the file to ANAPOS.txt before I can run it.
Is there any code that will allow my macro to search for ANAPOS with out all the other info at the end?
Any help appreciated.
Set filePath to where you want to search
Sub getANAPOS()
Dim Filter As String, filePath As String
filePath = "C:\Data\VBA\SO\"
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"
ANAPOSSelectedFile = Application.GetOpenFilename(Filter)
End Sub
EDIT FOLLOWING CLARIFICATION BY OP
Sticking with the same theme, this should give you some scope to work with. It essentially 'automatically' renames the selected file in situ, unless it already exists. Acknowledgements to #Gary's Student for his neat ideas to parse the GetOpenFileName result, here.
Sub renameANAPOS()
Dim Filter As String, filePath As String, newName As String
'filter txt file names containing 'ANAPOS'
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"
'the 'rename' name
newfName = "ANAPOS"
'navigate to original ANAPOS file and location details
ANAPOSSelectedFile = Application.GetOpenFilename(Filter)
'parse selected file details
fullArr = Split(ANAPOSSelectedFile, "\")
detArr = Split(fullArr(UBound(fullArr)), ".")
fullArr(UBound(fullArr)) = ""
fPath = Join(fullArr, "\")
fName = detArr(0)
fExt = detArr(1)
'rename file in not already exixts
If Len(Dir(fPath & newfName & "." & fExt)) > 0 Then
MsgBox newfName & "." & fExt & " already exists in this folder."
Exit Sub
Else
Name ANAPOSSelectedFile As fPath & newfName & "." & fExt
End If
End Sub