VBA: Save to sharepoint - excel

I am trying to build a macro that save excel file to sharepoint based on cell value.
I have two cells that:
*the sharepoint path is copied from Teams using copy link.
"A1" = sharepoint path
"A2" = file name
Below is the VBA that I used.
But whenever I run it, it will show this error.
Run-time error '1004':
Method 'SaveAs' of object '_Worksheet' failed
Sub filename_cellvalue()
Path1 = Range("A1").Value
myfilename = Range("A2").Value
ActiveWorkbook.SaveAs Filename:=Path1 & myfilename & ".xlsx"
End Sub
Thank you in an advance.

Saving a worksheet to another file location in SharePoint will only work if ALL the following are true:
The current user account has write access to the target location.
The active document source is inside the same SharePoint environment as the target.
The SharePoint environment does NOT block macro enabled files.
The file is being saved as a macro enabled file considering we're literally writing the macro to do the Save As. It doesn't matter that there's no other code on the worksheet. This is a macro and therefore the worksheet will have to be saved as such.
When all these conditions are met, the following should do the trick:
Public Sub SaveToSharePoint()
targetFile = Range("A1").Value
targetPath = Range("B1").Value
ActiveWorkbook.SaveAs Filename:=targetPath & targetFile & ".xlsm"
End Sub

Related

extract full path of hyperlink of a cell

how do you extract the full path of a hyperlink in a cell, ive been given a workbook with a list of generated hyperlinks cells and im trying to extract the full path
when i select a cell and press CTRL+K it just shows the path as ../folder/filename also when i use a vba code below it just shows the same value
what i would like is the full path like "C:\Users\username\folder\filename"
Range("C4") = Cells(4, 1).Hyperlinks(1).Address
i changed the property hyperlink base to 'C:' and then i generated a sample hyperlink and got a '\Users\username\folder\filename' but the earlier cells with hyperlink has still the same result
there isn't any method of properties you can make use of to get the full path.
what you can consider doing is, if the hyperlink is an Excel workbook, you can open it up and then make use of the FullName property, then close the workbook.
Dim wb As Workbook, fullpath As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
fullpath = wb.FullName
wb.Close SaveChanges:=False
End If
Next wb

vba to create and save a function in another file

i have this excel macro in a file that calls a text file and converts it into excel then saves the new excel file to a specific location. each time I run the macro a new excel file will be created. however, I want this macro to add some functions inside this file in a specific sheet before saving it to the new directory and next time I open the new excel file the function should be running normally and if i go to the vba window i should see my function there.
1- i run the macro from my macro file
2- it opens my new excel and adds a function inside sheet1 and saves the excel file in it's new directory
any ideas on how to do that ?
thanks and best regards
Please, test the next code. It creates a new workbook (you may use the one you obtained opening the text file), inserts a standard module (named "TestModule"), creates a Sub ("WrittenFromAnotherWorbook") and then creates the same test Sub in the "Sheet1" module. The new saved workbook ("TestWorkbookWithCode.xlsm") can be found in the same path with the workbook keeping this code:
Sub CreateNewWorkbookAddMacro()
'It needs a reference to 'Microsoft Visual Basic for Applications Extensibility 5.3'
Dim wb As Workbook, project As VBProject, component As VBComponent
Dim code(1 To 3) As String, i As Long, boolFound As Boolean
Const moduleName As String = "TestModule"
Set wb = Workbooks.Add
Set project = wb.VBProject
code(1) = "Sub WrittenFromAnotherWorbook()"
code(2) = " MsgBox ""Hello from the new workbook!"""
code(3) = "End Sub"
For Each component In project.VBComponents
'if the module has already been created, exit the code:
If component.Name = moduleName Then boolFound = True: Exit For
Next
If Not boolFound Then
Set component = project.VBComponents.Add(vbext_ct_StdModule)
component.Name = moduleName
'Put the code in place:
For i = LBound(code) To UBound(code)
component.CodeModule.InsertLines i, code(i)
Next
End If
Set component = project.VBComponents(wb.Worksheets(1).CodeName)
'Put the (same) code in place:
For i = LBound(code) To UBound(code)
component.CodeModule.InsertLines i, code(i)
Next
wb.SaveAs ThisWorkbook.Path & "\TestWorkbookWithCode.xlsm", xlOpenXMLWorkbookMacroEnabled
End Sub
If you are not familiar with references adding, please use the next code to programmatically add the needed one:
Sub addExtenssibilityReference()
'Add a reference to 'Microsoft Visual Basic for Applications Extensibilty 5.3':
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
End Sub
You must firstly run this code, save your workbook keeping the code and then run the one able to do what I explained above.
Please, test it and send some feedback.

Using VBA in Excel to force save in directory

I have a huge Excel spreadsheet that I need to allow access to a large set of users so they can manipulate it for their customers, but I don't want them to be able to overwrite the original file (a variable easily set in Excel) or save their file outside the current folder - so I want to force them in a "saveas" mode, and force the file to be saved in that folder. Otherwise, they won't be able to save. I'm not much of a VBA person, and I've found a lot of examples that may work, but nothing seems to be exactly what I need or maybe I'm not smart enough to figure it out. I found this code, but I'm not sure it FORCES the issue. Help?
I've tried to manage this in GPOs but everything seems to give them access to download the folder and save in other places.
Sub ExampleToSaveWorkbookSet()
Dim wkb As Workbook
'Adding New Workbook
Set wkb = Workbooks.Add
'Saving the Workbook
wkb.SaveAs "C:\WorkbookName.xls"
'OR
'wkb.SaveAs Filename:="C:\WorkbookName1.xls"
End Sub
Expected output is the amended Excel file saved in the original directory with a different name, or not at all.
Here's a macro that runs on open and immediately saves as .xlsx to a user location you can specify. Unfortunately the original needs to be .xlsm to store a macro.
This macro is to be located in the "ThisWorkbook" object. It will exit before making a copy when you open the workbook.
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = ActiveWorkbook
vWbName = wb.Name
vUserProf = Environ("USERPROFILE")
vx = InStr(1, vUserProf, "Users\")
If "<Use your own profileID>" = Mid(vUserProf, vx + 6) Then Exit Sub
vDir = vUserProf & "\Downloads\"
vWbName = Left(vWbName, Len(vWbName) - 5) & ".xlsx"
wb.SaveAs vDir & vWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox "You are now using a copy of the original"
End Sub

Accessing Excel 2010 sheets in another instance of Excel via VBA

I have a process that generates multiple spreadsheets. It doesn't save them, which is fine because Normally they would be saved manually.
I want to write a macro that accesses each sheet sequentially, perform some magic and then save and close the sheet.
When using Excel 2016, this is not an issue.
But I have Excel 2010 at work, and it cant see any of the work books.
With Excel 2016 this method works:
Workbooks("Book3").sheets("B3T1").activate
ActiveWindow.WindowState = xlMaximized
with Excel 2010 this is the message I receive:
Workbooks("Book3").sheets("B3T1").activate
runtime error '9'. Subscript out of Range
What is the method I should use to open an external workbook
Thanks, in advance
Assuming the workbook being accessed is already saved at a location.
This will open the external Files and access them. The macro will also close and save the file.
Dim wb As Workbook
Dim fileloc As String
fileloc = "" & "C:namenamename" & ".xlsm" & ""
Set wb = Workbooks.Open(fileloc)
wb.Worksheets("Sheet1").activate
wb.Close savechanges:=True
The worksheet isn't saved by the process that generates the work sheet. That is a manual operation. There are 100 worksheets and I wanted a way to avoid having to maximize each sheet/process it/save it.
The GetObject method finally worked:
For ptr = 1 To 100
Set xlApp = GetObject("Book" & ptr).Application
xlApp.Application.Workbooks("Book" & ptr).Sheets(1).Activate
do some processing
xlApp.Application.Quit
next
A one hour+ process is now reduced to 1 second

Extract data from text and selfdestruct

I'm currently working at a Uni project using Excel VBA and I'm trying to find a way to create an excel that will self destruct if it doesn't find the "Key". And in the event it's entirely impossible, then at least ensure there's none of the data or VBA code left.
The idea is that, using
Private Sub Workbook_Open()
Dim direct As String, name As String
name = ActiveWorkbook.Name
ChDir ThisWorkbook.Path
direct = ThisWorkbook.Path
Call Checker(direct, name)
End Sub
Upon opening the excel, it will look for "Key.txt" which should be within the same folder as the excel and check if the one string of text inside the document matches with "Code" which is a "Public Const" inside the project.
I've been trying to find a way to read the "Key.txt" without opening it, but haven't turned up anything.
On the other hand, I've been testing out various ways of making the program delete the original excel file, varying levels of success. So a somewhat roundabout way I've been testing out is to have the excel SaveAs a ".xlsx" and erase the original file before closing itself, but it doesn't work out as I've hoped for.
This is the code I've used for the "Self-Destruct" method:
Option Explicit
Function Checker(MyPath As String, name As String)
On Error Resume Next
Application.DisplayAlerts = False
Dim myPath2 As String
Dim ws As Worksheet
Dim FSO As Object
myPath2 = MyPath
ActiveWorkbook.SaveAs Filename:=MyPath & "\0_0.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "1"
For Each ws In Worksheets 'Deletes all other sheets
If ws.Name <> "1" Then ws.Delete
Next
Set FSO = CreateObject("scripting.filesystemobject")
If Right(MyPath, 1) = "\" Then MyPath = Left(MyPath, Len(MyPath) - 1)
If FSO.FolderExists(MyPath) = False Then MsgBox MyPath & " doesn't exist"
FSO.deletefile MyPath & "\" & name, True 'Deletes original file
ActiveWorkbook.Save
ActiveWorkbook.Close
End Function
Having a self-destructing file is an interesting idea. The short answer is that you cannot delete a running VBA macro. Therefore, no VBA macro can essentially self destruct. Yet, there are two options I can think of:
(1) Remove everything but the running macro. The following code might be helpful to achieve that.
http://www.erlandsendata.no/english/index.php?d=envbavbedeleteallmacros
(2) Close the file and ask Windows to delete the file afterwards for you using the task planner. The following post on SO might be able to help with that.
Using Excel vba Macro to be run through Windows Schedule Task
Other tempting solutions might be to save the file as .xlsx or to create a new Excel file, copy the above code from option 1 into that file, call the newly created code, which essentially deletes the original file.
But the real questions I'd ask myself would be: How did this person got the self-destructing file? Was it by email and the file is still in the email? Has the file been duplicated along the way? Are there hidden copies in some Temp-Folders (remember Excel Auto-Safe every xx minutes in case of computer crash to preserve your work)? Is the person enabling macros when opening the file (to allow self-destruction)? Can the person resore the file with the many free programs out there to recover files from a Windows machine (extremely easy as Windows does not delete the file or writes cryptical data on top to ensure it cannot be recovered, but merely "marks" that space on the HD where the file was as free to use for the next file to come)?

Resources