I am trying to open an excel file from a sharepoint library bearing the same name via VBA. Here are variables
Define Variables:
Private Master_File As String
Private Master_FileLocation As String
Private Master_Open As Workbook
Assign_Variables:
Master_File = "Master Data.xlsx"
Master_FileLocation = "http://sharepoint/page"
Sub Open_Master()
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
On Error Resume Next
Set Master_Open = Workbooks.Open(Master_File)
If Master_Open Is Nothing Then
Workbooks.Open FileName:=Master_FileLocation & "/" & Master_File, ReadOnly:=False
End If
End Sub
The code runs with no errors yet no excel file is opened. When I click on the file and copy the "shortcut" directly from my internet explorer browser, this is what appears:
http://sharepoint/org/%20Master%20Data/%20Master%20Data.xlsx
When I copy this path and paste it into a folder search bar I am able to open the folder. Therefore, I know the file + folder exists. I also understand some functions such as ChDir and GetOpenFileName don't work with HTTP. That said, my function is pretty simple and doesn't require those functions. Any help would be appreciated.
Related
I have some code that when the workbook opens, checks to see if an add-in is there, and depending on the scenario, downloads a copy from onedrive.
My issue is that on the initial running, it errors with a subscript out of range on the last add-in install line. If the user closes excel and reopens, then it installs without issue. Stranger, if I have them delete the add-in from the add-ins folder, it still installs fine when they open the workbook. It's always the initial running that flags the error. For now I've been putting an on error handler that instructs them to re-open excel when the initial install error triggers. Any ideas?
sUserName = Environ("username")
sSourceAddInPath = "C:\Users\" & sUserName & "\xxxxxxxxxx\Excel\MyAddIn.xlam"
sDestinationAddInPath = Application.UserLibraryPath & "MyAddin.xlam"
'Add-in exists
If Dir(sDestinationAddInPath) <> "" Then
'Update if newer version available
If FileDateTime(sSourceAddInPath) > FileDateTime(sDestinationAddInPath) Then
FileCopy sSourceAddInPath, sDestinationAddInPath
End If
'No Add-in
Else
FileCopy sSourceAddInPath, sDestinationAddInPath
End If
AddIns("MyAddIn").Installed = True
I solved it by changing the code and using the Add method.
Addins.Add sSourceAddInPath
From testing, it appears I don't need to test and copy the add-in file locally. The Add method will create a registry entry linked to the add-in stored in the user's local onedrive folder, which is also linked to the sharepoint site. This way, when I update the file on sharepoint, it updates their onedrive version.
I also added a helper function stored in the opening workbook to test if the add-in was loaded(i.e., in the list of add-ins) so as to not have to call Add each time the workbook is opened. Not sure if that matters, to be honest.
Function AddInIsLoaded(sAddInName as String) As Boolean
Dim aiAddIn as AddIn
Dim bLoaded as Boolean
bLoaded = False
On Error Resume Next
'Will error if add-in not loaded
Set aiAddIn = AddIns(sAddInName)
If Err.Number = 0 Then
bLoaded = True
End If
AddInIsLoaded = bLoaded
End Function
Updated code:
sUserName = Environ("username")
sSourceAddInPath = "C:\Users\" & sUserName & "\xxxxxxxxxx\Excel\TheAddIn.xlam"
If Not AddInIsLoaded("TheAddInName") Then
AddIns.Add sSourceAddInPath
End If
AddIns("TheAddInName").Installed = True
I have a workbook that is password protected and I’d like to create a read only copy that other users can view on a different location on the network drive.
I know it’s a strange request as the other people could open the original as read only, but we don’t want them to know the location of the original or have anything to do with it, should they figure out my colleagues password.
The other issue we had was that people were opening as read only and it was still telling my colleague that it was locked by another user and he needs it for most of the day so that issue is annoying
Thanks in advance
What you could do is add the following event procedure to the ThisWorkbook module:
Const RemotePath As String = "D:\YourRemoteLocation\"
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo CleanUp
If Success And InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
Dim CopyFullName As String
CopyFullName = RemotePath & "Copy of " & ThisWorkbook.Name
Application.EnableEvents = False
Dim fso As FileSystemObject 'Requires the Microsoft Scripting Runtime Library
Set fso = New FileSystemObject
fso.CopyFile Source:=ThisWorkbook.FullName, Destination:=CopyFullName
Dim ReadOnlyWorkbook As Workbook
Set ReadOnlyWorkbook = Workbooks.Open(Filename:=CopyFullName)
Application.DisplayAlerts = False
ReadOnlyWorkbook.SaveAs Filename:=CopyFullName, Password:=""
Application.DisplayAlerts = True
ReadOnlyWorkbook.Close SaveChanges:=False
End If
CleanUp:
Application.EnableEvents = True
Application.DisplayAlerts = True
Set fso = Nothing
End Sub
This code will run every time the workbook is saved and export the current file to the remote location. Then it will open the copy and save it as a workbook without password.
Note that I've added InStr(ThisWorkbook.Name, "Copy of ") = 0 as a condition to the If-statement. Instr returns the position where a substring (arg2) appears in the main string (arg1) or zero if the substring is absent from the main string. In this context, we want it to be zero since we don't want to run the code in the workbook copy.
In this method, the owner of the original file will have to supply their password every time they save. You could automate this by passing the password as an argument to the Open method like this:
Set ReadOnlyWorkbook = Workbooks.Open( _
Filename:=CopyFullName, _
Password:="MyPassword")
However, the password would then be accessible by people looking into the VBA code.
Alternatively you could get the password from a local file that wouldn't be accessible from the Network, but then the file path would be visible.
And if the remote folder is not already set to be Read-only mode, you can make sure that people opening the remote version of the file do so in Read-Only mode by adding the following event procedure after the previous one.
Private Sub Workbook_Open()
If InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub
Obviously this will only work if they enable macros.
I have been searching for a way to distribute macros to my tech illiterate office in the simplest way I can.
From my research, saving the Macros into a .xlam add-in would seem to be headed in the right direction.
Is it also possible to set up a custom ribbon tab in this manner?
Thus far I have failed to find any guides and our office security may also block certain avenues.
Edit:
Using W-Hit's excellent solution, and setting up the folder structure as indicated, it definitely helps make deploying an update much easier with the DeployAddIn subroutine.
I also found it useful to put the DeployAddIn and InstallAddin subroutines into a custom ribbon tab of their own!
I ran into a problem with the InstallAddin subroutine however: how to format the XML text in VBA without running into syntax errors.
I discovered that Each Element must have mso at the start e.g. <button> becomes <mso:button> and each "speech marked section" in a line must have ""double speech marks".
Perhaps the easiest way to use this install function is to save and edit the code into an active file, then open C:\Users[username]\AppData\Local\Microsoft\Office\Excel.officeUI in Notepad++. Then simply perform a find and replace to add in the extra quotation marks and paste it into the ribbonXML = "insert your text here" section of the code, ensuring it is encapsulated by the final speech marks to mark the entire section as a text string.
I might also look into adding extra functionality here... having an inputbox or userform that allows you to paste the code in at this point rather than have you enter the VBA editor to paste it in.
I currently do this, and it's a somewhat in depth process to setup, but runs smoothly once it is.
1st step is to create a folder structure with testing and production copies of your .xlam files that you are the admin for.
2nd, in the production folder, right click all .xlam files and set the attributes in the properties to Read-only. If you don't you'll never be able to update the addin if anyone else is in it.
3rd, when you make updates to the code in the testing file, just replace the production file with the updated file, and change to Read-only again. Users will only have to close all instances of excel and reopen to have the most up-to-date copy of the add-in.
Below is an admin add-in I use to move testing files to production.
Sub DeployAddIn()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To deploy finished/updated add-in to a network
' location as a read only file
Dim strAddinDevelopmentPath As String
Dim strAddinPublicPath As String
Dim FSO As New FileSystemObject
'Set development path
ChDrive "R:"
ChDir "R:\addins\PROJECTS"
strAddinDevelopmentPath = Application.GetOpenFilename()
If strAddinDevelopmentPath = "False" Then
Exit Sub
ElseIf InStr(strAddinDevelopmentPath, "\PRODUCTION\") > 1 Then
If MsgBox("You've Selected a Production File To Replace a Production File. Would You Like To Continue Anyway?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
'Get Desitination path
strAddinPublicPath = Replace(strAddinDevelopmentPath, "TESTING", "PRODUCTION")
'Create dir if it doesn't exist
On Error Resume Next
MkDir Left(strAddinPublicPath, InStrRev(strAddinPublicPath, "\") - 1)
On Error GoTo 0
'Turn off alert regarding overwriting existing files
Application.DisplayAlerts = False
'overwrite existing file
On Error Resume Next
SetAttr strAddinPublicPath, vbNormal
On Error GoTo 0
FSO.CopyFile strAddinDevelopmentPath, strAddinPublicPath, True
SetAttr strAddinPublicPath, vbReadOnly
'Resume alerts
Application.DisplayAlerts = True
End Sub
4th, I've also written a macro to change the custom ribbon. The below link, in addition Ron deBruin's site is useful. https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Code to automate addin install after you get the right text from the officeUI file
Sub InstallAddin()
'Adapted from https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Dim eai As Excel.AddIn
Dim alreadyinstalled As Boolean
Dim ribbonXML As String
'check if already installed
For Each eai In Application.AddIns
If eai.Name = "Main addin.xlam" Then
eai.Installed = False
Exit For
End If
Next
'add and install the addin
Set eai = Application.AddIns.Add("path to Main addin.xlam", False)
eai.Installed = True
'append quick access ribbon xml to add button
ClearCustRibbon
LoadNewRibbon
'have to close addin for it to load properly the first time
Workbooks("Main addin.xlam").Close
End Sub
Sub ClearCustRibbon()
'https://social.msdn.microsoft.com/Forums/vstudio/en-US/abddbdc1-7a24-4664-a6ff-170d787baa5b/qat-changes-lost-when-using-xml-to-modify-ribbon-excel-2016-2016?forum=exceldev
Dim hFile As Long
Dim ribbonXMLString As String
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXMLString = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon>" & _
"<mso:qat>" & _
"<mso:sharedControls>" & _
"</mso:sharedControls>" & _
"</mso:qat>" & _
"</mso:ribbon>" & _
"</mso:customUI>"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXMLString
Close hFile
End Sub
Sub LoadNewRibbon()
Dim hFile As Long
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXML = "your ribbon text here"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
End Sub
***IMPORTANT---- If you install the addin manually, make sure you select no when prompted if you want the file saved to the local machine. If you save it to the local machine, it creates a local copy, and will never update if you make changes to the network copy or need to fix an error.
There are more tips, but you'll mostly need to adapt them to fit how you operate. Hope that helps.
For the purpose of version control for my file, I want to be able to run a script that compares Cell A1 on Sheet VC, to the same cell/sheet of a version stored on Sharepoint when I run my script. Fairly new to using VBA and cant work out how to do it and cant find the answer im looking for on google.
The code I want to use:
Public Sub version_control()
Sheets("VC").Calculate
If Sheets("VC").Range("A1").Value <> (this is where I want it to check cell A1 sheet VC on the Sharepoint file)
MsgBox "Please download the latest version from the Sharepoint"
Application.Quit
End If
End Sub
Guessing, you don't already have the SharePoint file open ... if that's true skip down.
But if it's open you can reference it like any other open workbook ... e.g. both of these should work:
debug.Print Workbooks("MySharePointWorkbook.xlsx").Sheets("VC").Range("A1").Value
debug.Print Workbooks.Item(n).Sheets("VC").Range("A1").Value
Probably not already open right? Without getting into the weeds of external data links, I would just obtain the full URL of the SharePoint file (open it, ? Activeworkbook.FullName in the Immediate Window) and store that string in serverFileName like this:
Public Sub version_control()
Dim serverFileName As String 'obtain url for sharepoint filename, insert below
Dim valuesAreDifferent As Boolean 'so we can do housekeeping below
Dim x As New Excel.Application 'make a new session for the sharepoint version
Dim w As Workbook 'grab-handle for the sharepoint file
Sheets("VC").Calculate
valuesAreDifferent = False 'implicit, being explicit
serverFileName = "http://whatever-domain.com/MySharepointWorkbook.xlsx"
x.Visible = False 'so it doesn't flash up when checking
Set w = x.Workbooks.Open(serverFileName) 'open the sharepoint version
If Sheets("VC").Range("A1").Value <> w.Sheets("VC").Range("A1").Value Then _
valuesAreDifferent = True
'housekeeping in case we don't quit
w.Close
x.Quit
Set w = Nothing
Set x = Nothing
If valuesAreDifferent Then
MsgBox "Please download the latest version from the Sharepoint"
Application.Quit
End If
End Sub
Very new to this so please help. Im trying to mass update files in a static folder location, many files in one folder.
What i want to do is
run VBA macro in Excel 2010 to goto a network location folder,
open the first file in the folder.
Unprotect the workbook and worksheets call another marco to run changes
then protect the worksheet close the file
and then move onto the next file in the folder until all files have been corrected.
I have created the marco to make the changes, this is called "Edit"
File types are xlsm and the workbook and worksheet are password protected How can i automatically run the macro to goto the network location and in series open each file, unprotect, call the macro, then re protect the document close file and move onto the next file until they are all updated.
Sub Auto_open_change()
Dim WrkBook As Workbook
Dim StrFileName As String
Dim FileLocnStr As String
Dim LAARNmeWrkbk As String
PERNmeWrkbk = ThisWorkbook.Name
StrFileName = "*.xlsx"
FileLocnStr = ThisWorkbook.Path
Workbooks.Open (FileLocnStr & "\" & StrFileName)
Workbooks(StrFileName).Activate
With Application.FindFile
SearchSubFolders = False
LookIn = "Network location"
Filename = "*.xlsm"
If .Execute > 0 Then
Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
WrkBook.Worksheets(1).Select
ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
Next i
Else
Debug.Print "There were no files found."
End If
Im managing to unprotect the file update and reprotect the file fine, just cant get the file from the network location.
I'm using Excel 07, which doesn't allow Application.FindFile, so I can't test this. However, I believe the issue may be that you need to Set the variable Wrkbook, not just assign it.
Change
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
to
Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
and let me know how that turns out!