Copy Open Excel File - excel

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

Related

VBA to open Excel Workbook if file exists, and open a different if it does not

I have spent my whole morning on this and cannot get it working properly. A simple Excel userform was created asking for a filename. If the file exists in the directory I want it to open. If it does not exist I want a "template" file opened instead. I have the does not exist working properly, however cannot get the "does exist" part working. Please help.
Private Sub CmdEnter_Click()
Dim Path As String
Dim File As String
Path = Range("Search!B1")
File = TxtOrder.Value
'If File exists then open.
If Dir(Path & File & ".xlsm") = Path & File & ".xlsm" Then
Workbooks.Open FileName:=Path & File & ".xlsm"
'If File does not exist then open.
ElseIf Dir(Path & File & ".xlsm") = Error Then
Workbooks.Open FileName:=Path & "QCSFormTrial.xlsm"
End If
'Close Dialog and Close Workbook
Workbooks("QCSLaunch.XLSM").Close SaveChanges:=False
End Sub
Please, try this way:
Private Sub CmdEnter_Click()
Dim Path As String, File As String, wb As Workbook
Path = Range("Search!B1")
File = TxtOrder.value
'If File exists then open.
If dir(Path & File & ".xlsm") <> "" Then
Set wb = Workbooks.Open(Path & File & ".xlsm")
Else 'else, open the other one:
Set wb = Workbooks.Open(Path & "QCSFormTrial.xlsm")
End If
Stop 'check if the workbook has been open and press F5 to let code finishing
wb.Close SaveChanges:=False
End Sub
The issue is that Dir(Path & File & ".xlsm") = Path & File & ".xlsm" is basically saying does the folder path I named equal the folder path I named. The path isn't actually directed at the actual folder in way that will open it.
Try this: https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
Sub LoopAllFilesInAFolder()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Users\marks\Documents\")
While fileName <> ""
'Insert the actions to be performed on each file
'This example will print the file name to the immediate window
Debug.Print fileName
'Set the fileName to the next file
fileName = Dir
Wend
End Sub
Or, you can remove the If Then and directly open the file. If the file exists, it will open, if not, it will error. You can use error handling then continue.

How to save opened workbook in the same workbook directory with same file extension but different name using AddIn?

I tried the following code in workbookopen of .xlam file but it saves the Add-In and not the opened running workbook in the directory.Also the following only works for .xlsm file.
What i really wanted is to save the running instance of excel workbook/s with different file names in current directory with same extension whenever i run the Add-in !
Sub saveas()
Dim wbname As String
Dim pathONLY, filePATH, fileONLY As String
filePATH = ThisWorkbook.FullName
fileONLY = ThisWorkbook.Name
pathONLY = Left(filePATH, Len(filePATH) - Len(fileONLY))
wbname = "NewFile"
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=pathONLY & wbname & ".xlsm"
End Sub

Looping code error-Excel says that it can't find the file

I'm trying to write a code that will refresh all workbooks starting with 'FY' in a folder. With the current code, the first two workbooks refresh, but when it comes to the third workbook, I get this error:
Sorry, we couldn't find FY20 11-15.xlsm\FY20 1-5.xlsm. Is it possible it was moved, renamed or deleted?"
The path to the workbook is "C:\Documents\Database\Sales".
Here's the code:
Sub refreshdata()
Dim file As String
Dim book As String
file = Application.ThisWorkbook.Path
book = Dir(file & "\FY*.xlsm")
Do While file <> ""
Dim wb As Workbook
Set wb = Workbooks.Open(file & "\" & book)
Call Refresh
wb.Close savechanges:=True
file = Dir
Loop
End Sub
You named your variables not clearly and file contains actually a path file = Application.ThisWorkbook.Path therefore you mixed everything up. Get your variable names more meaningful! Make sure your variables are well named after what content they contain or you confuse yourself.
Sub refreshdata()
Dim Path As String
Path = Application.ThisWorkbook.Path
Dim FileName As String
FileName = Dir(Path & "\FY*.xlsm")
Do While FileName <> vbNullString
Dim wb As Workbook
Set wb = Workbooks.Open(Path & "\" & FileName)
Call Refresh
wb.Close SaveChanges:=True
FileName = Dir
Loop
End Sub
What was wrong?
Here file = Dir you set your file variable which actually was the path to filename. And in the next iteration of the loop Set wb = Workbooks.Open(file & "\" & book) is twice a filename, the new filename in file and the old in book.

How to open files contained in a folder in current file path

I want to open a file (file) that is stored in a folder (Source) which is in the same directory as the current workbook. I get a runtime error 1004 indicating that it the file can't be located. What am I doing worng?
Set x = Workbooks.Open(ThisWorkbook.Path & "\Source\file*.xlsx")
Since you want the wildcard to stay, you need to loop through the files in the folder. Something like this may be of interest to you:
Sub FileOpen()
Dim sPath As String
Dim sFile As String
Dim wb As Workbook
sPath = ThisWorkbook.Path & "\Source\"
sFile = Dir(sPath & "file*.xlsx")
' Loops while there is a next file found in the specified directory
' When there is no next file the Dir() returns an empty string ""
Do While sFile <> ""
' Prints the full path of the found file
Debug.Print sPath & sFile
' Opens the currently found file
Set wb = Workbooks.Open(sPath & sFile)
' Place your code here
' Place your code here
' Place your code here
' Close the current workbook and move on to the next
wb.Close
' This line calls the Dir() function again to get the next file
sFile = Dir()
Loop
End Sub
Good luck!
Replace the wildcard with actual filename.
Set x = Workbooks.Open(ThisWorkbook.Path & "\Source\file.xlsx"
I changed the file*.xlsx to file. xlsx...hope your code works.
thanks.

Runtime error 1004 when trying to upload file to SharePoint

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"

Resources