I need to download a really large file in msaccess via a vba application.
Using the objects MSXML2.ServerXMLHTTP.6.0 and WinHttp.WinHttpRequest.5.1 result in an error stating that there is not enough storage available to complete this operation. Therefore i resorted in using the DoFileDownload method from shdocvw.dll.
What i want to do is pass an extra header (an API key) to the request sent by the function.
Here is roughly what i want to do.
Private Declare Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long
Public Sub Download()
sDownloadFile = StrConv(<link_to_download>, vbUnicode)
'set a header before calling DoFileDownload
Call DoFileDownload(sDownloadFile)
End Sub
How do i approach this problem?
A WebRequest downloading a whole file at once stores the whole data in response.
Although there are options to chunk response, using Wget is less coding, but more options.
Private Sub DownloadFileWget()
Const PathToWget As String = "" 'if wget is not in path use "Path\To\Wget"
Dim LinkToFile As String
Dim SavePath As String
With CreateObject("WScript.Shell")
LinkToFile = "http://download.windowsupdate.com/microsoftupdate/v6/wsusscan/wsusscn2.cab" 'huge file > 500MB
SavePath = "C:\doc" 'folder to save download
.CurrentDirectory = SavePath
.Run Chr(34) & PathToWget & "wget.exe" & Chr(34) & " --header='name: value' " & Chr(34) & LinkToFile & Chr(34) & " -N", 1, True
' -N: Continue download only if the local version is outdated.
End With
End Sub
Related
So we have a system that requires users to log in and it has there own roaming profile. So in this string of code how can i target the current users document folder? (FYI excel 2010)
'WORKAROUND:
Dim PID As Double
Dim strRootPath As String
Const strExpExe = "explorer.exe"
Const strArg = " " '" /e,/root, "
'this is where i need to figure out how to target current user's documents
'// Change rootpath here
strRootPath = "C:\Data Files"
PID = Shell(strExpExe & strArg & strRootPath, 3)
the rest of the function does great... it opens file explorer i just cant figure the syntax for telling it to look for the current user.
Probably the best way would be with a function like this:
Function docsFolder() As String
docsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
End Function
There are other ways too but this one will work on any version of Windows and with user customizations.
For example, in my case, I have my documents folder on a mapped X: drive, so simply stuffing my username into a C:\ path would not work.
More Information:
Stack Overflow : Language independent way to get “My Documents” folder in VBA
Microsoft Technet : What is the path to My Documents?
MSDN : Wshell: SpecialFolders Property
I'm not sure how flexible you want this to be but you could try the following
strRootPath = "C:\Users\" + Environ("Username") + "\Documents"
Got it! thanks! for anyone that might care... The final string that made her run!
Function docsFolder() As String
docsFolder =
CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
End Function
Private Sub test()
Dim PID As Double
Dim strRootPath As String
Const strExpExe = "explorer.exe"
Const strArg = " " '" /e,/root, "
'// Change rootpath here
strRootPath = "C:\Users\" + Environ("Username") + "\Documents"
PID = Shell(strExpExe & strArg & strRootPath, 3)
End Sub
I've been trying to upload file to Azure storage using VBA in Microsoft Access but so far without success.
I have had a good search around and have found some code which looks promising but I can't get it to work. Seems like many others have been looking for a similar solution or help with working with Azure from VBA.
This is the code;
Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
'--- read file
nFile = FreeFile
Open sFileName For Binary Access Read As nFile
If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
Get nFile, , baBuffer
sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
If Not bAsync Then
pvPostFile = .ResponseText
End If
End With
End Sub
Private Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
(Thanks to - https://wqweto.wordpress.com/2011/07/12/vb6-using-wininet-to-post-binary-file/)
When I try this code using my azure storage URL in the form
https://XXXXX.blob.core.windows.net/
and a filename (C:\Temp\Test.txt) I get the following error;
<?xml version="1.0" encoding="utf-8"?><Error><Code>UnsupportedHttpVerb</Code><Message>The resource doesn't support specified Http Verb.
I suspect there's a problem in the header or post data rather than the VBA and this is not really my area.
Any help greatly appreciated.
I came across this post as I'm searching the same answer for uploading images to Azure Blob Storage. I took me 2 days to get the answer. And the code posted above did help me to partly solve the problem.
I would like to post my solution here in case anyone else is looking for the same answer.
Before you can use the code below, you need to get the Shared Access Signature (SAS) from your Azure portal (manage panel). You should be able to google the answers on this.
Public Sub UploadAfIle(sUrl As String, sFileName As String)
Dim adoStream As Object
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Mode = 3 ' read write
adoStream.Type = 1 ' adTypeBinary
adoStream.Open
adoStream.LoadFromFile (sFileName)
With CreateObject("Microsoft.XMLHTTP")
adoStream.Position = 0
.Open "PUT", sUrl, False
.setRequestHeader "Content-Length", "0" 'this is not a must
.setRequestHeader "x-ms-blob-type", "BlockBlob"
.Send adoStream.Read(adoStream.Size)
End With
Set adoStream = Nothing
End Sub
sURL is a URL looks like (I'm in China so the Host is different): https://myaccount.blob.core.chinacloudapi.cn/products/newimagename.jpg?sv=2016-05-31&ss=bfpq&srt=dco&sp=rydlscup&se=2017-07-30T18:40:26Z&st=2017-07-28T10:40:26Z&spr=https&sig=mJgDyECayITp0ivVrD4Oug%2Bz%2chN7Wpo2nNtcn0pYRCU%4d
The one bolded is the SAS token you generated from Azure.
Worth noting the format of the sUrl in SiliconXu's answer is made up of 3 parts, I didn't realise at first so got a sore head for a while!!
1) Azure blob container URL (from the properties in the Storage Explorer)
2) the filename (this is the part I omitted by mistake)
3) Shared Access Signature
So is built like this
sURL = destination_folder & "/" & local_file_name & "?" & conn_SAS
I don't have the reputation require to comment directly below that answer
Great code though, as soon as I worked out the format of the sURL it worked like a dream
Azure Storage Service uses private key authentication. Since VBA runs on the end user's machine you are exposing yourself to a whole slew of risks associated with that key getting into the wild. I would recommend rethinking the whole premise of going directly from VBA to Azure Storage and utilize your own WebAPI to handle storing data to Blob.
This would have the dual benefit of:
1) making it easier to integrate with from VBA and
2) protecting your Azure Storage private key behind a component of your solution that doesn't get deployed to the end user's machine.
I would like to convert images downloaded from the internet[1] to JPGs with ImageMagick in VBA. So far, I've attempted two methods that have both failed.
First, I tried using the ImageMagickObject 1.0 Type Library:
Private Sub CommandButtonOkay_Click()
Dim sURL As String, sNetFile As String, sLocalFile As String, _
cmd As String, RetVal As Integer, img As Object
Set img = New ImageMagickObject.MagickImage
sURL = UserForm1.TextBoxImgURL
sLocalFile = "C:\temp\" & UserForm1.TextBoxName
DownloadFile sURL, sLocalFile ' Function to download image from a URL and save it to a local directory
RetVal = img.Convert(sLocalFile, sLocalFile & ".jpg") '<-- This line produces the error
UserForm1.Hide
End Sub
This ends up giving me the following error:
The source file ("C:\temp\image") exists, but the file that was to be created ("C\temp\image.jpg") does not. This is very similar to the question posted here, but I have not been able to find a solution to that so far.
Second, I tried just calling ImageMagick using the Shell command:
Private Sub CommandButtonOkay_Click()
Dim sURL As String, sNetFile As String, sLocalFile As String, _
cmd As String, RetVal As Integer
sURL = UserForm1.TextBoxImgURL
sLocalFile = "C:\temp\" & UserForm1.TextBoxName
DownloadFile sURL, sLocalFile ' Function to download image from a URL and save it to a local directory
RetVal = Shell("convert.exe """ & sLocalFile & """ """ & sLocalFile & ".jpg""")
UserForm1.Hide
End Sub
When I run this, the image gets downloaded just fine, but the image isn't converted and no error is thrown. Furthermore, when I execute the command that the Shell command executes in a separate command window, the conversion happens exactly as I would expect.
So the question then seems to be why is the ImageMagick command working beautifully when it is operating in its own command prompt, but not working at all when operating from within VBA?
[1] I don't know if this is useful information or not, but I'm downloading the images from the internet programmatically, so I have no means of knowing what format I'm getting; however, the image I've been using to test this with is a PNG.
The problem is the Shell is really only for opening programs. Therefore, it is necessary to actually tell it to open a command prompt and run the appropriate command. This can be done by changing the line with the Shell command to the following:
RetVal = Shell("cmd.exe /c convert.exe """ & sLocalFile & """ """ & sLocalFile & ".jpg""")
Is there any way to have outlook start an external application or service based on an outlook calendar task, event, appointment? Also if so, is there a way to get it to pass parameters to it?
Yes you can do this using the Shell method.
Private Sub TestAcrobatReader()
Const strcProgramName As String = _
"C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"
Const strcFilePath As String = _
"C:\Program Files\Adobe\Reader 9.0\Reader\plug_ins\" _
& "Annotations\Stamps\Words.pdf"
Dim dblProgTaskID As Double
Dim strPathName As String
strPathName = strcProgramName & " " & strcFilePath
dblProgTaskID = Shell(strPathName, vbMaximizedFocus)
MsgBox "Program Task ID: " & dblProgTaskID
End Sub
Code borrowed from here. You can pass additional parameters by concatenating them on the strPathName.
For automating based on Outlook Calendar there is a wealth of information here.
I'm using System.IO.File.Copy to copy a file to c$ on a remote server. I need to specify username/password for the connection. Is there a simple way to do this? I had hoped that System.IO.File.Copy would accept credentials as an argument but it doesn't. How can I do this?
You cant add credentials to the system.io.file but there seems to be a workaround here:
http://forums.asp.net/t/1283577.aspx/1
Snippet from above link:
using (System.Security.Principal.WindowsImpersonationContext ctx = System.Security.Pricipal.WindowsIdentity.Impersonate(userTokenptr))
{
//do your IO operations
ctx.Undo();
}
Converted to vb.net:
Using ctx As System.Security.Principal.WindowsImpersonationContext = System.Security.Pricipal.WindowsIdentity.Impersonate(userTokenptr)
'do your IO operations
ctx.Undo()
End Using
Credits goes to Ganeshyb
Absolute simplest thing to do is to add this routine to your code then call it right before your File.Copy:
Private Sub Open_Remote_Connection(ByVal strComputer As String, ByVal strUsername As String, ByVal strPassword As String)
'//====================================================================================
'//using NET USE to open a connection to the remote computer
'//with the specified credentials. if we dont do this first, File.Copy will fail
'//====================================================================================
Dim ProcessStartInfo As New System.Diagnostics.ProcessStartInfo
ProcessStartInfo.FileName = "net"
ProcessStartInfo.Arguments = "use \\" & strComputer & "\c$ /USER:" & strUsername & " " & strPassword
ProcessStartInfo.WindowStyle = ProcessWindowStyle.Hidden
System.Diagnostics.Process.Start(ProcessStartInfo)
'//============================================================================
'//wait 2 seconds to let the above command complete or the copy will still fail
'//============================================================================
System.Threading.Thread.Sleep(2000)
End Sub