I am trying to link Sharepoint 365 into an Excel Workbook. Previously, I was using wshell to mount the Sharepoint drive to my computer and access everything locally. Sharepoint 365 doesn't allow you to do that, so I am using the API. Here are my steps:
Login to Sharepoint and get an access token (OAuth2 handshake)
Search for a file or navigate Sharepoint List/Folder/File tree to find a file (this is done through various Sharepoint API calls returning the relevant objects I am looking for)
Download the file from Sharepoint onto the local drive (read only operations at the moment)
There are a bunch of automated procedures I have been using to interact with data downloaded from various files, this will not change.
With the Sharepoint 365 API, I am stuck at step 3.
I'm using a class to instantiate my Sharepoint session and keep track of my file object. My unit test looks like this:
Sub testDownload()
Dim spFile As New sp365
Dim reqObj As Object
Dim jsonObj As Object
Dim dlStatus As Long
'first log in
spFile.login
'now get a request object that contains filenames and their relative URLs
Set reqObj = spFile.testQuery
'extract the info to a JSON object
Set jsonObj = jsonify(reqObj.responseText, "")
'hardcoding these parameters for now because I just want to download this one file
Debug.Print "Filename: " & jsonObj("d.results(0).Name")
Debug.Print "Relative Url: " & jsonObj("d.results(0).ServerRelativeUrl")
dlStatus = spFile.downloadTemporaryFile(jsonObj("d.results(0).ServerRelativeUrl"), jsonObj("d.results(0).Name"))
If dlStatus = 0 Then
Debug.Print "File Created"
Else
Debug.Print "File not created. Status = " & dlStatus
End If
out:
Exit Sub
End Sub
The relevant code here lies in downloadTemporaryFile. Obviously, I am using the windows urlmon code, which seems to be the de facto way to download files in Excel:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
And downloading the (temporary) file is here:
Function downloadTemporaryFile(relativeUrl As String, fileName As String) As Boolean
On Error GoTo errHandler
'Download a file to a temporary path
'Keep the file inside the class object until it is closed
Dim userPath As String
Dim filePath As String
Dim url As String
Dim wshShell As Object
'Get the windows shell version for special folders
Set wshShell = CreateObject("WScript.Shell")
'get the documents folder for this computer
userPath = wshShell.SpecialFolders("MyDocuments")
'all logs are stored in <user>/Documents/logs
filePath = userPath & SHAREPOINT_TEMP_FOLDER
'Check if the 'SharepointTemp' folder exists
'if not, create the directory
If Dir(filePath, vbDirectory) = "" Then MkDir (filePath)
'Extract the site (this can differ based on the connected app)
'FYI: TENANT_DOMAIN is obtained during the Sharepoint Login procedure
url = "https://" & TENANT_DOMAIN & relativeUrl
'download it now
Debug.Print "Downloading to: " & filePath & fileName
Debug.Print "Downloading from: " & url
downloadTemporaryFile = URLDownloadToFile(0, url, filePath & fileName, 0, 0)
out:
Exit Function
errHandler:
logDump "Error", "sp365.downloadTemporaryFile", Err.Number & ";" & Err.source & ";" & Err.description
End Function
So this seems like it would work, and URLDownloadToFile returns 0 (S_OK). But only a tiny part of the file is in my download folder. The file I am trying to download in the example is 2MB, the file in my folder is only 4kb and it won't open. I haven't even gotten to cksum yet, but of course it would fail. I've tried other Sharepoint download links (like .linkingUrl and .linkingUri), but I get the same result. When I paste the url the way I have constructed it above into my browser, the file downloads just fine.
Edit: The file is actually an HTML file. It looks like this:
<html><head><title>Working...</title>
</head><body><form method="POST" name="hiddenform" action="https://keysighttech.sharepoint.com/_forms/default.aspx">
<input type="hidden" name="code" value="..." />
<input type="hidden" name="id_token" value= "..."/>
<input type="hidden" name="session_state" value= "..." />
<input type="hidden" name="correlation_id" value="..."/>
<noscript><p>Script is disabled. Click Submit to continue.</p>
<input type="submit" value="Submit" /></noscript></form>
<script language="javascript">document.forms[0].submit();</script></body></html>
How can I proceed with the download? Any suggestions?
Thank you in advance!
I figured it out. Basically, the UrlDownloadToFile routine does not pass any authentication along with it. So when I send a request for a file, either I get a 401 Unauthorized, an error which basically just spits my request back to me, or the "hint" i posted above, which basically is a redirect with all of the tenant and authentication methods. So instead, I went ahead get authorized and included the headers that I usually use with standard Sharepoint API requests and it returned the file to me in a bit stream. The final class function looks something like this:
Dim url As String
Dim filePtr As Long
Dim oResp() As Byte 'byte array to store the response object
Dim reqObj As Object
'make sure we can navigate to the right folder on people's computers
Dim userPath As String
Dim filePath As String
Dim wshShell As Object
Dim reqKey() As String
Dim reqVal() As String
'Get the windows shell version for special folders
Set wshShell = CreateObject("WScript.Shell")
'get the documents folder for this computer
userPath = wshShell.SpecialFolders("MyDocuments")
filePath = userPath & SHAREPOINT_TEMP_FOLDER
'Check if the 'SharepointTemp' folder exists
'if not, create the directory
If Dir(filePath, vbDirectory) = "" Then MkDir (filePath)
reqKey = sharepointHeadersKeys
reqVal = sharepointHeadersVals
'Extract the site (this can differ based on the connected app)
url = relativeUrl & SHAREPOINT_BINARY_REQUEST
Set reqObj = getRequest(url, bearer:=AuthToken.item("access_token"), key:=reqKey, value:=reqVal, blnAsync:=True)
'now the file should be in reqObj
oResp = reqObj.responseBody
'Create a local file and save the results
filePtr = FreeFile
Debug.Print "Downloading to: " & filePath & fileName
If Dir(filePath & fileName) <> "" Then Kill filePath & fileName
Open filePath & fileName For Binary As #filePtr
Put #filePtr, , oResp
Close #filePtr
Now I can use the file from my temp folder as I was before. I am using the metadata.uri returned from the API call and associated with the file object that I queried. This seems to me to be the easiest and cleanest way to do it - especially because I can search the file binary if I am looking for specific text or keywords and save the overhead of opening the file at all. But, of course, I am open to other methods and suggestions.
Related
I'm writing a program which writes links into an excel sheet based on various data found in the sheet. My company used SOLIDWORKS PDM to store files, so I'm using the PDM API (the pdmv object) to write the links. Some of the files don't exist due to faulty data, so I need some kind of error checking before referencing the pdmv object and writing the link.
The issue I'm running into is with case-sensitive file locations. GetFolderFromPath and GetFile commands are case-insensitive, so the program writes links without problems if they exist. However, since the Dir command is case-sensitive, I can't properly check if the files exist before running the link-writing commands.
Is there any way to use Dir without worrying about case, or is there a different, case-insensitive method to checking if a file exists that might work here?
Thanks for the help.
EDIT:
evidently, Dir is case-insensitive, so the issue must be arising from the server that my company uses to store files, SOLIDWORKS PDM. Unfortunately, this doesn't fix the issue, so any ideas are welcome.
Sub writeLink(link As String, palRow As Long, asArray, pdmv As Object)
Dim textDisp As String
textDisp = asArray(1) & "-" & asArray(2) & "-1000"
Dim filename As String
filename = textDisp & ".sldasm"
testVar = Dir(link & "\" & filename)
If Not testVar = "" Then
Dim efolder As Object
Dim efile As Object
Set efolder = pdmv.GetFolderFromPath(link)
Set efile = efolder.GetFile(filename)
fileLink = "conisio://myvault/explore?projectid=" & efolder.id & "&documentid=" & efile.id & "&objecttype=1"
calc.Hyperlinks.Add Anchor:=calc.Cells(palRow, 8), _
Address:=fileLink, _
TextToDisplay:=textDisp
Else
calc.Cells(palRow, 2).Interior.Color = 65535
End If
End Sub
I have been doing checks with worksbooks for things like if the sheet exists or what is in a cell without opening the workbook using this command
f = "'" & strFilePath1 & "[" & strFileType & "]" & strSheetName & "'!" & Range(strCell).Address(True, True, -4150)
CheckCell = Application.ExecuteExcel4Macro(f)
and it has been working well but now i am wanting to check if the sheet is Password protected without opening but haven't been successful. Anyone know if this is possible?
Thanks for help in advance
Yes! It is possible. I discovered how to do it long time ago. I doubt this is mentioned anywhere in the web...
Basic Introduction: As you are aware, Microsoft Excel up until 2007 version used a proprietary binary file format called Excel Binary File Format (.XLS) as its primary format. Excel 2007 onwards uses Office Open XML as its primary file format, an XML-based format that followed after a previous XML-based format called "XML Spreadsheet" ("XMLSS"), first introduced in Excel 2002.
Logic: To understand how this works, do the following
Create a new Excel file
Ensure it has at least 3 sheets
Protect the 1st sheet with a blank password
Leave the 2nd sheet unprotected
Protect the 3rd sheet using any password
Save the file, say, as Book1.xlsx and close the file
Rename the file to, say, Book1.Zip
Extract the contents of the zip
Go to the folder \xl\worksheets
You will see that all the sheets from the workbook has been saved as Sheet1.xml,Sheet2.xml and Sheet3.xml
Right click on the sheets and open it in notepad/notepad++
You will notice that all the sheets you protected has one word <sheetProtection as shown below
So if we can somehow check if the relevant sheet has that word then we can ascertain whether the sheet is protected or not.
Code:
Here is a function which can help you in what you want to achieve
'~~> API to get the user temp path
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Sub Sample()
'~~> Change as applicable
MsgBox IsSheetProtected("Sheet2", "C:\Users\routs\Desktop\Book1.xlsx")
End Sub
Private Function IsSheetProtected(sheetToCheck As Variant, FileTocheck As Variant) As Boolean
'~~> Temp Zip file name
Dim tmpFile As Variant
tmpFile = TempPath & "DeleteMeLater.zip"
'~~> Copy the excel file to temp directory and rename it to .zip
FileCopy FileTocheck, tmpFile
'~~> Create a temp directory
Dim tmpFolder As Variant
tmpFolder = TempPath & "DeleteMeLater"
'~~> Folder inside temp directory which needs to be checked
Dim SheetsFolder As String
SheetsFolder = tmpFolder & "\xl\worksheets\"
'~~> Create the temp folder
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(tmpFolder) = False Then
MkDir tmpFolder
End If
'~~> Extract zip file in that temp folder
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(tmpFolder).CopyHere oApp.Namespace(tmpFile).items
'~~> Loop through that folder to work with the relevant sheet (file)
Dim StrFile As String
StrFile = Dir(SheetsFolder & sheetToCheck & ".xml")
Dim MyData As String, strData() As String
Dim i As Long
Do While Len(StrFile) > 0
'~~> Read the xml file in 1 go
Open SheetsFolder & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
For i = LBound(strData) To UBound(strData)
'~~> Check if the file has the text "<sheetProtection"
If InStr(1, strData(i), "<sheetProtection", vbTextCompare) Then
IsSheetProtected = True
Exit For
End If
Next i
StrFile = Dir
Loop
'~~> Delete temp file
On Error Resume Next
Kill tmpFile
On Error GoTo 0
'~~> Delete temp folder.
FSO.deletefolder tmpFolder
End Function
'~~> Get User temp directory
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
Note: This has been tested for .xlsx and .xlsm files.
There is a ZIP data file at http://portal.flmmis.com/FLPublic/Provider_ManagedCare/Provider_ManagedCare_Registration/tabId/77/Default.aspx?linkid=pmlwhich contains a CSV that I need to utilize in my Access database.
This file is updated daily which is why the process needs to be automated. After extracting the CSV from the ZIP file into an Excel file, I need to replace all commas within the file with a space.
After that I need to import that file into a database titled Network_DB so that I can produce reports based on that and other data sets. It is comma delimited.
I have no idea where to start. I've seen suggestions for Python, PowerShell, Excel macros...the whole nine yards. I'll say that I don't have access to Python at work and I'm unfamiliar with PowerShell.
If you are using MS Access already then VBA is the easiest way to tackle this problem.
To download a file from the web you can use this snippet:
Sub downloadUrl(url As String, destinationFile As String)
Dim htp As New MSXML2.XMLHTTP60
Dim stream As New ADODB.Stream
'Request file
With htp
.Open "GET", url, false
.send
End With
'Save to file
With stream
.Open
.Type = adTypeBinary
.write htp.responseBody
.SaveToFile destinationFile
.Close
End With
End Sub
Then call this function like this
downloadUrl "http://portal.flmmis.com/FLPublic/Provider_ManagedCare/Provider_ManagedCare_Registration/tabId/77/Default.aspx?linkid=pml", "C:\Users\Public\test.csv"
To import a CSV to MS Access you can use one of the import wizards to help you.
Ps.: I tried to access the provided link but it seems to be offline for me
You can use the DownLoadFile function here:
Show pictures directly from URLs in Access forms and reports
to download the file. Then unzip it using a function like this:
Public Function UnzipFile( _
ByVal ZipFile As String, _
Optional ByRef DestinationFolder As String) _
As Boolean
Const LocalAppData As String = "LOCALAPPDATA"
Const OverWriteAll As Long = &H10&
Dim ShellApp As Object
Dim FileName As String
Dim Result As Boolean
' Any error will cause a return value of False.
On Error Resume Next
FileName = Dir(ZipFile, vbNormal)
If InStr(StrReverse(ZipFile), StrReverse(FileName)) = 1 Then
' ZipFile exists.
If DestinationFolder = "" Then
' Find and use user's LocalAppData folder, and return constructed folder name.
DestinationFolder = Environ(LocalAppData) & "\" & Left(FileName, InStr(FileName, ".")) & "Files"
End If
If Dir(DestinationFolder, vbDirectory) = "" Then
' Create new destination folder.
MkDir DestinationFolder
End If
If InStr(StrReverse(DestinationFolder), StrReverse(Dir(DestinationFolder, vbDirectory))) = 1 Then
' Destination folder existed or has been created successfully.
Set ShellApp = CreateObject("Shell.Application")
' Unzip files to destination folder.
ShellApp.Namespace(CVar(DestinationFolder)).CopyHere ShellApp.Namespace(CVar(ZipFile)).Items, OverWriteAll
If Err.Number = 0 Then
Result = True
End If
End If
End If
UnzipFile = Result
Set ShellApp = Nothing
End Function
Is it possible to define a string variable in excel and then use that variable inside Access?
I have a program where in Excel a window pops up asking for where a file is located which will feed into an Access database - get processed - then shoot into Excel. The problem is that this is for a lot of different people and so each computer is going to have its own extension address of where the file is located, so it is necessary to have it be easy for users to identify where their file is located instead of hard-coding it into the VBA.
No matter what I try, I can't seem to figure out how to get the string variable to talk to the access database so it knows where to go look for the file.
I can't seem to find a solution for this. Anyone have any ideas?
Here is the code I have so far: This is what is inside the excel file----
'CommandButton1 is a button inside of a form window that pops up for the user to enter the address of the file
Public Sub CommandButton1_Click()
'both of these are public/global variables defined in a global macro
locationaddress = txbBrowse2.Value
LocationOfData = txbBrowse.Value
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
'location of data is the location of the access file itself
location address is the string that I'm trying to feed into access
appAccess.OpenCurrentDatabase LocationOfData, exclusive:=False
appAccess.Application.Run "DoExcelImport"
End Sub
'Here is the code inside the access file, the idea is that it will modify the "Import-TEST" saved import. It will change where it pulls the excel sheet that contains a bunch of items that requires access to process.
Sub DoExcelImport()
DoCmd.SetWarnings False
Dim ies As ImportExportSpecification, i As Long, oldXML() As String, newXML As String
Set ies = CurrentProject.ImportExportSpecifications("Import-TEST")
oldXML = Split(ies.XML, vbCrLf, -1, vbBinaryCompare)
newXML = ""
For i = 0 To UBound(oldXML)
If i = 1 Then
' re-write the second line of the existing XML
newXML = newXML & _
"<ImportExportSpecification Path = """ & _
locationaddress & _
""" xmlns=""urn:www.microsoft.com/office/access/imexspec"">" & _
vbCrLf
Else
newXML = newXML & oldXML(i) & vbCrLf
End If
Next
ies.XML = newXML
ies.Execute
Set ies = Nothing
DoCmd.SetWarnings True
End Sub
Probably the easiest way might be using
SaveSettings(AppName As String, Section As String,Key As String, Setting As `String)
to store the string in the registry,
GetSettings((AppName As String, Section As String,Key As String)
to get it in Access, and
DeleteSetting (AppName as String)
to delete it.
Is probably a bit abusing the registry, but an easy way.
Thanks for this excellent resource, it has been of great assistance to me, but I am having a problem using excel VBA to download excel files from a remote server. I suspect it is something obvious that my code is lacking.
The problem I am having is that all the downloaded files are always 15KB in size, regardless of the size or content of the original file and all bear the same content which appears to be text simply copied from the host website, rather than the file I am trying to download. I have tried using various file extensions including CSV but the results are the same.
When I open the downloaded file excel says the file format and extension don't match and then says that, due to problems during load, the file is "missing file C:\remote\css\logon.css" and "missing file C:\remote\javascript\ramjsfx.menu.css", which is Greek to me.
Sub DownloadFilefromWeb()
Const E_OUTOFMEMORY As Long = &H8007000E
Const E_DOWNLOAD_FAILURE As Long = &H800C0002
Dim InitialName As String
Dim Msg As String
Dim RegExp As Object
Dim RetVal As Long
Dim SaveName As String
Dim SavePath As String
Dim URL As String
URL = InputBox("Enter the download URL below.", "Download from Internet")
If URL = "" Then Exit Sub
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = "^(.*\/)(.+)$"
InitialName = RegExp.Replace(URL, "$2")
Set RegExp = Nothing
If InitialName = "" Or InitialName = URL Then
MsgBox ("Error - Missing File Name")
Exit Sub
End If
SavePath = Application.GetSaveAsFilename(InitialName)
If SavePath = "" Then Exit Sub
'SavePath = "C:\Users\Rob's Laptop\Documents\Test\Test3.xls"
'URL = "https://remote.picosting.co.uk/Remote/fs/files.aspx?path=%5c%5cPISBS2011%5cfiles%5cRob% 20Shaw%27s%20test%20folder%5cTest1"
RetVal = URLDownloadToFile(0&, URL, SavePath, 0&, 0&)
Select Case RetVal
Case 0
Msg = "Download Successful"
Case E_OUTOFMEMORY
Msg = "Error - Out of Mmemory"
Case E_DOWNLOAD_FAILURE
Msg = "Error - Bad URL or Connection Interrupted"
Case Else
Msg = "Unknown Error - " & RetVal
End Select
MsgBox Msg
End Sub
Kind regards
Rob
URLDownloadToFile() is literally and simply downloading the .aspx page that is on the server - when accessed through a normal web broswer, that page does server side logic to obtain and download the Excel file you are trying to get. The css files it is complaining about are stylesheet files that are used to control the display of the .aspx page.
You will need to use something more complex than URLDownloadToFile() to save the file that you want, for example setting up an IE Application object as described here:
http://www.mrexcel.com/forum/excel-questions/502298-need-help-regarding-ie-automation-using-visual-basic-applications.html