I'm trying to export an excel file from a website. The path that I am provided already clicks the export the file and opens a prompt that asks what I want to do with the file. How do I access the prompt box to open the file?
I've tried the code where you open the path to the google gif but it doesn't work with this since the path doesn't really lead to my content. My goal is to open the excel file and export the content to my main excel file (the one containing the macro).
Ive tried this but this only works on direct link to content and not to saving prompt.
Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
oXMLHTTP.send 'send request
'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF
'Clear memory
Set oXMLHTTP = Nothing
End Function
This works if the path is the web content itself. I need work from a path that initiates download of the file. Thanks!
Related
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.
How can I get the byte array of the opened Word Document (.docm) without saving it to a local drive first.
The document will be opened on a Thin Client without any local drive from SharePoint. When the user want to save the changes, I need to send the byte array to a web-service to process it. (Not back to SharePoint).
Dim filePath As String
Dim fileName As String
Dim fullFileName As String
filePath = ThisDocument.path
fileName = ThisDocument.Name
fullFileName = filePath + "/" + fileName
the value of filePath is 'http://webiste/application'
the value of fileName is 'theOpenFileName.docm'
the value of fullFileName is 'http://webiste/application/theOpenFileName.docm'
How can I get the whole file as a byte array so I can send it to the web-service like this:
Dim bytFile() As Byte
Dim http
Dim userName As String
Dim url As String
Set http = CreateObject("MSXML2.ServerXMLHTTP")
userName = "Me"
'--- read file
bytFile = ??????????
'--- send the file to the API server
url = "http://localhost/DocWebApi/Post?fileName=" & fileName & "&userName=" & userName
http.Open "POST", url, False
http.Send (bytFile)
http.waitForResponse 4000
Thanks in advance!
Try the next approach, please:
Sub testByteArray()
Dim bytFile() As Byte, strDocShare As String
Dim fileDoc As Integer: fileDoc = FreeFile
strDocShare = Application.GetOpenFilename("Office Documents (*.docm),*.docm", , "Please select document to be processed...")
If strDocShare = False Then Exit Sub 'If no document has been selected
Open strDocShare For Binary Access Read As #fileDoc
ReDim bytFile(0 To LOF(fileDoc) - 1)
Get #fileDoc, , bytFile
Close #fileDoc
End Sub
If the document will be open, the above code may return an error. A method to determine if a shared document/workbook is open by other user, uses some similar code and catches the error...
The following code will open and save the testing PDF in question, but will not write any of the values in the XML file referenced into the saved form. The PDF was created by Livecycle, hence the XFA reference in the code. For the life of me, I cannot figure out why this command is not executing and not returning an error if it is somehow faulty.
Sub LoopTrial()
Dim strPDFPath As String
Dim MyFile As String
MyPath = "H:\Testing\Forms\"
strPDFPath = "H:\Testing\Test Form.pdf"
myExtension = "1.xml"
MyFile = MyPath & myExtension
'Loop
'Do While MyFile <> ""
Set objAcroApp = CreateObject("AcroExch.App")
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
If objAcroAVDoc.Open(strPDFPath, "") = True Then
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
Set objJSO = objAcroPDDoc.GetJSObject
End If
objJSO.importXFAData MyFile
i = i + 1
strPDFOutPath = "H:\Testing\Forms\Form" & i & ".pdf"
objAcroPDDoc.Save 1, strPDFOutPath
objAcroApp.Exit
'Loop
End Sub
For security reasons, the importXFAData method is only allowed in batch and console events. You won't be able to execute it directly via VBA. You'll need to create a trusted function first and load it as an application level JavaScript, then call the trusted function. You'll also need to convert your path that will be a parameter for the JSO from Windows format to one that Acrobat JavaScript will understand... something like...
"C/foo/data.xfa"
for...
"C:\foo\data.xfa"
To create a trusted function, create a JavaScript (.js) file and load it into the Acrobat application JavaScript folder. It will look like this...
trustedImportXFAData = app.trustedFunction( function (pathToXFA)
{
// Additional code may appear above
app.beginPriv(); // Explicitly raise privilege
this.importXFAData(pathToXFA); //"this" being the form document
app.endPriv();
// Additional code may appear below.
})
The from VBA you'll call it the same way.
objJSO.trustedImportXFAData MyFile
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
I'm looking to open a dialogue box to select a HTML file by clicking on a button in Excel.
Once it opens the file, I need to save it as a mht file with the same name, in the same directory it was opened from. Then import the mht file to excel (it keeps it's format that way).
So far I've only come across the code:
'.Navigate C://file path'
which is no good as the files are always in different locations.
The code I've got so far is:
Sub Convert_HTML()
Dim ie As Object
Dim MyFile As String
Set ie = CreateObject("internetexplorer.application")
With ie
.Navigate MyFile = Application.GetOpenFilename("html Files (*.html), *Jackstandwithfoil*.html", 1, "Open Jackstand with foil HTML File")
.Visible = True
End With
ie.Visible = True
End Sub
This gets me the dialogue box to select the HTML file, opens IE (my work's preferred browser).
But I get IE trying to open "http://false/" instead of the selected file.
If I click close/Cancel, the same web address comes up.
I'm trying to automate an Excel form for work so we don't have to open the file, then 'save as' multiple times a day which is needed for proof for clients.
I've searched many forums for the same/similar code needed so any help would be greatly appreciated!
Change
.Navigate MyFile = Application.GetOpenFilename("html Files (*.html), Jackstandwithfoil.html", 1, "Open Jackstand with foil HTML File")
To
MyFile = Application.GetOpenFilename("html Files (*.html), *Jackstandwithfoil*.html", 1, "Open Jackstand with foil HTML File")
.Navigate MyFile
This template creates a new workbook in Excel and sets a reference to the first worksheet.
Const WorkBookPath = "C:\My Excel Files\Sales.xls"
Const WorkSheetName = "Sales Data"
Dim xlApplication, xlWorkbook, xlWorksheet
Set xlApplication = CreateObject("Excel.Application")
xlApplication.Visible = True
Set xlWorkbook = xlApplication.Workbooks.Open()
Set xlWorksheet = xlWorkbook.Worksheets(1)
xlWorksheet.Range("A1") = 10
xlWorkbook.Save
xlWorkbook.Close
xlApplication.Quit
Ok, so I've not managed to save as a mht. Looking at many forums and being a novice, I couldn't get anything to work and definitely couldn't read/understand enough of it to alter it.
I've simply got it to copy & paste straight from a HTML file selected by the user in to the current workbook (the one I found opened a new workbook every time).
You may need to create a macro to change the layout of the sheet or have one already set up like I do.
Sub Import_JST_woFoil()
Dim OST As Workbook
Dim IE As Object
Dim MyFile As String
MyFile = Application.GetOpenFilename() 'user selects file
Set OST = ThisWorkbook 'Doesn't need to be renamed. Rename to your Excel file name but MAKE SURE you rename the OST part above
Set IE = CreateObject("InternetExplorer.Application")
If MyFile = False Then Exit Sub 'Exits if Cancel or Close is clicked
IE.Visible = True 'Opens IE window
IE.Navigate MyFile 'Opens/views web page from file selected
'Wait to load page
Do While IE.ReadyState <> 4
DoEvents
Loop
'Below selects all & copy on webpage
IE.ExecWB 17, 2
IE.ExecWB 12, 2
Sheets("JST without Foil").Select 'Selects separate tab (Rename JST without Foil to whatever your tab is called)
ActiveSheet.Paste Range("A1") 'Pastes from cell A1
IE.Visible = False 'closes IE
Sheets("OutputForm").Select 'Selects original tab (Rename OutputForm to whatever tab you want to see at the end of the macro). Delete this line if you want to stay on the tab you paste the web page on to.
End Sub
I can supply links to the thread later (I don't have this to hand).
If you want to search for only a HTML file and no other type, replace
MyFile = Application.GetOpenFilename()
With
myFile = Application.GetOpenFilename("HTML Files (*.HTML), *<common filename>*.HTML", 1, "Open <common name> File")
Hope this helps others!