Copy from MS Word document to a web page input box - vba

In an already open word document select all text
copy selected text to clipboard
check default browser open at correct web address
if not open default browser at web address "http://thisaddress.com"
give focus to browser
paste clipboard text into input box called "input1"
or some other way to get MSword document contents to a web page input?
Currently the workflow involves a secretary logging in to the website, then filling out a web form, switching to their open MS Word document, selecting all, copying the WP document, then back to the web form and pasting into an input box, then hitting submit. What I want to do ideally have a button in MS word which opens the browser to the correct web page then copies and pastes the document into the correct input box on the page (in fact it will be the only textarea form field).
The MS Word VBA code is:
Option Explicit
Enum W32_Window_State
Show_Normal = 1
Show_Minimized = 2
Show_Maximized = 3
Show_Min_No_Active = 7
Show_Default = 10
End Enum
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Function OpenURL(URL As String, WindowState As W32_Window_State) As Boolean
' Opens passed URL with default application, or Error Code (<32) upon error
Dim lngHWnd As Long
Dim lngReturn As Long
lngReturn = ShellExecute(lngHWnd, "open", URL, vbNullString, _
vbNullString, WindowState)
OpenURL = (lngReturn > 32)
End Function
Sub TestMacro()
Application.ActiveDocument.Select
Selection.Copy
OpenURL "http://localhost:8500/index.cfm?wordContent=" & Selection, W32_Window_State.Show_Maximized
End Sub
and in the coldfusion handling form
<html>
<head>
</head>
<body>
<form id="form1">
<Textarea ID="txtArea" rows=6><cfoutput>#url.wordContent#</cfoutput></textarea>
</form>
</body>
</html>
Just would like to work out how to not open a new browser window if one is already open.

In case you can modify the web-application, you may do the following:
MS-Word: Copy content to clipboard.
MS-Word: Open Url as "http://thisaddress.com/SomePage?pasteClipboard=true"
SomePage: if query-string param pasteClipboard == true, then add a javascript function to get the clipboard data into your form field.
Update:
In your macro you simply call Selection.Copy, and to open the URL using default browser check this link http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_23225744.html
Using the code from the previous link, I made a test macro as :
Sub TestMacro()
Application.ActiveDocument.Select
Selection.Copy
OpenURL "http://thisaddress.com/SomePage?pasteClipboard=true", W32_Window_State.Show_Maximized
End Sub
I hope this was helpful.
Update 2:
Just use W32_Window_State.Show_Default, Here is the full macro:
Option Explicit
Enum W32_Window_State
Show_Normal = 1
Show_Minimized = 2
Show_Maximized = 3
Show_Min_No_Active = 7
Show_Default = 10
End Enum
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Function OpenURL(URL As String, WindowState As W32_Window_State) As Boolean
' Opens passed URL with default application, or Error Code (<32) upon error
Dim lngHWnd As Long
Dim lngReturn As Long
lngReturn = ShellExecute(lngHWnd, "open", URL, vbNullString, _
vbNullString, WindowState)
OpenURL = (lngReturn > 32)
End Function
Sub TestMacro()
Application.ActiveDocument.Select
Selection.Copy
OpenURL "http://thisaddress.com/SomePage?pasteClipboard=true", W32_Window_State.Show_Default
End Sub

Another option is to look into controlling Internet Explorer from inside Word using a control.
Here is an example.
Note, this will only work with IE (unless there are dll versions of Firefox etc.)

Related

VBA display a google static map in picture with long URL

I'm able to display a google static map in Excel.
Sheets("Sheet1").Range("a1").Parent.Pictures.Insert theURL
This works fine but once my URL is longer than 1650 characters I get an error message.
It's the same when I use a shape to display the map.
Sheets("Sheet1").Shapes("gMap").Fill.UserPicture theURL
Is there another way to display a google static map in Excel?
My URL I want to display could be <= 5000 characters. It's a map with a polyline.
There are URL examples:
URL with 1649 characters
https://maps.googleapis.com/maps/api/staticmap?size=600x600&path=enc%3Amym~h?g~uz`??e?a?q?a?k?c?u?e?s?i?}?m?{`?c?s?a?i?a?i?a?i?a?i?a?g?a?o?a?g?c?q?a?i?g?c`?a?i?m?w`?a?q?q?s`?c?i?s?u`?e?q?m?y`?e?q?o?}`?q?w`?a?g?o?w`?c?g?e?q?a?g?k?o`?o?y`?m?w`?q?w`?a?g?q?u`?a?g?i?y`?m?s`?a?g?k?y`?a?g?i?w`?a?g?e?{`??q?c?y`?g?w`?a?e?e?u?g?g`?m?}`?a?g?m?{`?o?y`?k?a`?i?a`?i?c`?o?s`?u?q`?i?y?o?}`?c?y?c?k`?a?o?k?{`?c?o?o?w`?a?g?m?w`?m?y`?a?g?m?g`?i?y?q?{`?c?o?e?u`?o?m`?a?g?e?c`?d?u?f?c?z?`?b`?b?``?b?f`?a?f??h?`?z??h`?d?|??z?c?f`?i?j??d`??d??z??p?c?d`?i?d??h`?c?h??d`?c?z?a?b??d`?c?~?i?v?k?h?c?b`?k?j?e?h??~?n?b`?c?d??d`?i?b`?u?f?u?`?o?e?u`?q?w`?q?w`?c?e?q?g`?o?y?k?k?}?y?w?g`?s?}?g?i?}?i`?e?e?u?g`?a?e?s?m`?i?c`?c?o?e?{?a?m??k?e?c`?e?a`?a?g?u?o`?a?g?a?e?m?i`?i?{???q?o`?k?w?e?m?m?m`?m?i`?u?m`?c?e?e?m?s?u`??q?i?y?y?k`?a?e?u?q`?q?w`?a?i?q?w`?m?w`?u?u`?s?s`?u?s`?c?g?s?q`?s?q`?e?k?m?m`?q?u`?c?e?o?c`?g?}?b?ca?c?{?m?c?o?n?w?|?c?b?u?r?y?d`?q?v`?s?|`?u?r`?g?n?k?v?g?l?i?n?u?m?a`?u?e?a?g`?y?e?c?e`?y?e?c?g`?u?i?e?c`?{?e?c?a`?y?g?e?a`?e`?{?}?{?h?a`?v?}?~?a?d?m?f`?g?n`?i?~`?e?z`?o?t`?c?f?m?|`?a?f?i?|`?k?v`?g?|`??v?a?~?c?z?`?ba??|?c?d?}?r?}?f`?q?r?e?l?m?l?a`?z?i?d?}?n?y?h?g?j?e?l?e?v?g?x`??|`?d?|`?`?l`?e?v`?d?z`?`?n?j?x`??f?h?z`??f?j?|`?b?t?f?v`?h?v`??f?p?|`?d?p?h?t`??v`?g?|`?c?p??~`?b?l?f?``?n?``?`?d?n?x?h?n?p?d`?r?l`?j?v?r?l`?t?p`?h?r?b?d?f?r?f?x?b?l?`?l?b?l?f?d`?`?f?b?h`?`?z??h?c?l`??f?c?l`?j?p`?n?r`?b?f?t?r`?d?n?f?v`?m?z?{?~?s?|?a`?|?a`?v?c?`?k?j?m?n?a`?z?c?b?a`?x?c`?|?c?b?a`?|?q?n?a`?z?e?b?y?x?{?~?`?d`?`?z?}?f`?i?d`??f??l`??r`?v?l`?t?p`?`?f?x?n`?t?~?x?d`?v?b`?j?t?`?b?j?p?h?j?b?b?z?``?v?``?h?j`??p`??f?j?z?|?b?v?a?h?b?v?r?z?m?``?w?b?c?~?{?f?e?b`?}?``?q?h?a?d`?w?
URL with 1653 characters
https://maps.googleapis.com/maps/api/staticmap?size=600x600&path=enc%3Amym~h?g~uz`??e?a?q?a?k?c?u?e?s?i?}?m?{`?c?s?a?i?a?i?a?i?a?i?a?g?a?o?a?g?c?q?a?i?g?c`?a?i?m?w`?a?q?q?s`?c?i?s?u`?e?q?m?y`?e?q?o?}`?q?w`?a?g?o?w`?c?g?e?q?a?g?k?o`?o?y`?m?w`?q?w`?a?g?q?u`?a?g?i?y`?m?s`?a?g?k?y`?a?g?i?w`?a?g?e?{`??q?c?y`?g?w`?a?e?e?u?g?g`?m?}`?a?g?m?{`?o?y`?k?a`?i?a`?i?c`?o?s`?u?q`?i?y?o?}`?c?y?c?k`?a?o?k?{`?c?o?o?w`?a?g?m?w`?m?y`?a?g?m?g`?i?y?q?{`?c?o?e?u`?o?m`?a?g?e?c`?d?u?f?c?z?`?b`?b?``?b?f`?a?f??h?`?z??h`?d?|??z?c?f`?i?j??d`??d??z??p?c?d`?i?d??h`?c?h??d`?c?z?a?b??d`?c?~?i?v?k?h?c?b`?k?j?e?h??~?n?b`?c?d??d`?i?b`?u?f?u?`?o?e?u`?q?w`?q?w`?c?e?q?g`?o?y?k?k?}?y?w?g`?s?}?g?i?}?i`?e?e?u?g`?a?e?s?m`?i?c`?c?o?e?{?a?m??k?e?c`?e?a`?a?g?u?o`?a?g?a?e?m?i`?i?{???q?o`?k?w?e?m?m?m`?m?i`?u?m`?c?e?e?m?s?u`??q?i?y?y?k`?a?e?u?q`?q?w`?a?i?q?w`?m?w`?u?u`?s?s`?u?s`?c?g?s?q`?s?q`?e?k?m?m`?q?u`?c?e?o?c`?g?}?b?ca?c?{?m?c?o?n?w?|?c?b?u?r?y?d`?q?v`?s?|`?u?r`?g?n?k?v?g?l?i?n?u?m?a`?u?e?a?g`?y?e?c?e`?y?e?c?g`?u?i?e?c`?{?e?c?a`?y?g?e?a`?e`?{?}?{?h?a`?v?}?~?a?d?m?f`?g?n`?i?~`?e?z`?o?t`?c?f?m?|`?a?f?i?|`?k?v`?g?|`??v?a?~?c?z?`?ba??|?c?d?}?r?}?f`?q?r?e?l?m?l?a`?z?i?d?}?n?y?h?g?j?e?l?e?v?g?x`??|`?d?|`?`?l`?e?v`?d?z`?`?n?j?x`??f?h?z`??f?j?|`?b?t?f?v`?h?v`??f?p?|`?d?p?h?t`??v`?g?|`?c?p??~`?b?l?f?``?n?``?`?d?n?x?h?n?p?d`?r?l`?j?v?r?l`?t?p`?h?r?b?d?f?r?f?x?b?l?`?l?b?l?f?d`?`?f?b?h`?`?z??h?c?l`??f?c?l`?j?p`?n?r`?b?f?t?r`?d?n?f?v`?m?z?{?~?s?|?a`?|?a`?v?c?`?k?j?m?n?a`?z?c?b?a`?x?c`?|?c?b?a`?|?q?n?a`?z?e?b?y?x?{?~?`?d`?`?z?}?f`?i?d`??f??l`??r`?v?l`?t?p`?`?f?x?n`?t?~?x?d`?v?b`?j?t?`?b?j?p?h?j?b?b?z?``?v?``?h?j`??p`??f?j?z?|?b?v?a?h?b?v?r?z?m?``?w?b?c?~?{?f?e?b`?}?``?q?h?a?d`?w?v?d?
Both URLs work when you copy them to your browser.
Here is an example using #Omegastripes idea of downloading to a folder first. My function in the comments, which converted to tinyURL also worked but can't be posted. Downloading to a folder is more robust however.
Note:
If on 32-bit remove the word PtrSafe
Code:
Private Declare PtrSafe 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
Private Sub DownloadPic()
Dim url As String
Dim fileLocation As String
url = "https://maps.googleapis.com/maps/api/staticmap?size=600x600&path="
url = url & "enc%3Amym~h?g~uz??e?a?q?a?k?c?u?e?s?i?}?m?{?c?s?a?i?a?i?a?i?a?i?a?g?a?o?a?g?c?q?a?i?g?c?a?i?m?w?a?q?q?s?c?i?s?u?e?q?m?y?e?q?o?}?q?w?a?g?o?w?c?g?e?q?a?g?k?o?o?y?m?w?q?w?a?g?q?u?a?g?i?y?m?s?a?g?k?y?a?g?i?w?a?g?e?{??q?c?y?g?w?a?e?e?u?g?g?m?}?a?g?m?{?o?y?k?a?i?a?i?c?o?s?u?q?i?y?o?}?c?y?c?k?a?o?k?{?c?o?o?w?a?g?m?w?m?y?a?g?m?g?i?y?q?{?c?o?e?u?o?m?a?g?e?c?d?u?f?c?z??b?b??b?f`?a?f??h?`?z??h`?d?|??z?c?f`?i?j??d`??d??z??p?c?d`?i?d??h`?c?h??d`?c?z?a?b??d`?c?~?i?v?k?h?c?b`?k?j?e?h??~?n?b`?c?d??d`?i?b`?u?f?u?`?o?e?u`?q?w`?q?w`?c?e?q?g`?o?y?k?k?}?y?w?g`?s?}?g?i?}?i`?e?e?u?g`?a?e?s?m`?i?c`?c?o?e?{?a?m??k?e?c`?e?a`?a?g?u?o`?a?g?a?e?m?i`?i?{???q?o`?k?w?e?m?m?m`?m?i`?u?m`?c?e?e?m?s?u`??q?i?y?y?k`?a?e?u?q`?q?w`?a?i?q?w`?m?w`?u?u`?s?s`?u?s`?c?g?s?q`?s?q`?e?k?m?m`?q?u`?c?e?o?c`?g?}?b?ca?c?{?m?c?o?n?w?|?c?b?u?r?y?d`?q?v`?s?|`?u?r`?g?n?k?v?g?l?i?n?u?m?a`?u?e?a?g`?y?e?c?e`?y?e?c?g`?u"
url = url & "?i?e?c`?{?e?c?a`?y?g?e?a`?e`?{?}?{?h?a`?v?}?~?a?d?m?f`?g?n`?i?~`?e?z`?o?t`?c?f?m?|`?a"
url = url & "?f?i?|`?k?v`?g?|`??v?a?~?c?z?`?ba??|?c?d?}?r?}?f`?q?r?e?l?m?l?a`?z?i?d?}?n?y?h?g?j?e?l?e?v?g?x`??|`?d?|`?`?l`?e?v`?d?z`?`?n?j?x`??f?h?z`??f?j?|`?b?t?f?v`?h?v`??f?p?|`?d?p?h?t`??v`?g?|`?c?p??~`?b?l?f??n??`?d?n?x?h?n?p?d`?r?l`?j?v?r?l`?t?p`?h?r?b?d?f?r?f?x?b?l?`?l?b?l?f?d`?`?f?b?h`?`?z??h?c?l`??f?c?l`?j?p`?n?r`?b?f?t?r`?d?n?f?v`?m?z?{?~?s?|?a`?|?a`?v?c?`?k?j?m?n?a`?z?c?b?a`?x?c`?|?c?b?a`?|?q?n?a`?z?e?b?y?x?{?~?`?d`?`?z?}?f`?i?d`??f??l`??r`?v?l`?t?p`?`?f?x?n`?t?~?x?d`?v?b`?j?t?`?b?j?p?h?j?b?b?z??v??h?j`??p`??f?j?z?|?b?v?a?h?b?v?r?z?m??w?b?c?~?{?f?e?b?}?``?q?h?a?d?w?v?d?"
fileLocation = "C:\Users\User\Desktop\TestFolder\Test.png"
If URLDownloadToFile(0, url, fileLocation, 0, 0) = 0 Then
Debug.Print "downloaded"
ThisWorkbook.Worksheets("Sheet1").Range("A1").Parent.Pictures.Insert fileLocation
Kill fileLocation
Else
Debug.Print "failed"
End If
End Sub
Result:

Open Hyperlinks in Access

I have a table of products where there is say a pdf for a specific products user manual. I'm storing the model name and it's file path in my products table (in Access). I've created a form in Access that allows the user to search by product name and it narrows down the number of files and shows the results from the search in a list box. However my biggest problem is opening the actual PDF. It opens the file, but I have to store the file path exactly how it is and the path of the files are long. Is there a way to open the PDF hyperlinks without using the Followhyperlink command? Or is there a way that I can show only the file name of the pdf in my list box rather than the entire path name? If I change the display text in my products table it doesn't open the hyperlink, I get an error. Any help would be greatly appreciated!
Application.FollowHyperLink() has problems with security, especially when opening files on a network drive. See e.g. here: http://blogannath.blogspot.de/2011/04/microsoft-access-tips-tricks-opening.html
A better method is the ShellExecute() API function.
Essentially it looks like this (trimmed from http://access.mvps.org/access/api/api0018.htm ):
' This code was originally written by Dev Ashish.
' http://access.mvps.org/access/api/api0018.htm
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Public Const WIN_NORMAL = 1 'Open Normal
Private Const ERROR_SUCCESS = 32&
Public Function fHandleFile(stFile As String) As Boolean
Dim lRet As Long
lRet = apiShellExecute(hWndAccessApp(), "Open", stFile, vbNullString, vbNullString, WIN_NORMAL)
If lRet > ERROR_SUCCESS Then
' OK
fHandleFile = True
Else
Select Case lRet
' Handle various errors
End Select
fHandleFile = False
End If
End Function
Now for your listbox:
Set it to 2 columns, the first being the model name, the second the file path.
Set the column width of the second column to 0, so it will be invisible.
And in the doubleclick event, call fHandleFile with the second column (file path):
Private Sub lstManuals_DblClick(Cancel As Integer)
Call fHandleFile(Me.lstManuals.Column(1))
End Sub

How to Close InfoBox.Popup on Timer Expiration?

I cobbled this test procedure together in Outlook 2013 from other posts.
It should display a popup box, and then close after 3 seconds.
It never closes.
Sub MessageBoxTimer()
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 3
Select Case InfoBox.Popup("Click OK (this window closes automatically after 3 seconds).", _
AckTime, "This is your Message Box", 0)
Case 1, -1
Exit Sub
End Select
End Sub
Some research suggests that this may be a bug in some MS Office applications. I'm basing this on the fact that this and this don't seem to say anything which suggests you're using the command in the wrong way, and this shows that other users have managed to get precisely this code to work.
I tested this on my Windows PC running Excel with Office 365 and have had the same issue as you - the message box is displayed, but not closed. I found a suggested workaround here, and the discussion on that page may be of some interest to you (particularly one user's description of trying to submit a bug report to Microsoft about VBA). The solution, proposed by a user called ウィンドウズスクリプトプログラマ, is to make a call through to the native user32.dll by declaring an external function - this page has some examples of how to call C dlls with VBA.The MessageBoxTimeout function is said to be undocumented by Microsoft, but you can find out a lot about it here.
The other option, which worked for me, is run a vbscript call to Shell.Popup with mshta.exe:
Function Test()
Dim Shell
Set Shell = CreateObject("WScript.Shell")
Shell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""Test"",3,""Message""))"
End Function
To get this to work with more complex messages, you may need to escape some characters. There is another SO question here which shows other uses for mshta's ability to execute vbscript in a shell/ console.
Finally, as was suggested by one user, you could simply create a custom user form with a doevents loop that counts down and then closes itself.
The WScript.Shell .Popup seems to be hit or miss in Office VBA.
If you are looking for a MsgBox that works in Office VBA and supports a timeout, I posted another method that uses a Windows API call. It supports timeout, carriage returns, and return values. You can find the code at this link. I did not think it was proper etiquette to post it again here.
Note that the mshta method mentioned by #Orphid does not support carriage returns and always shows the message on the primary monitor.
Yes, I can confirm that result: the 'Timeout' on the WsShell.Popup function is no longer working in Office.
It took me a while to notice, because popup dialogs with a 'cancel' button seem to be affected less. So this might be a usable workaround for you:
Dim msg AS String
Dim Title as String
msg ="Click 'Ok' or 'Cancel' (this window closes automatically after 3 seconds)."
Title = Application.name & ": Message Box test"
Select Case InfoBox.Popup(msg, AckTime, Title, vbQuestion + vbOkCancel)
If that doesn't work, you're going to need a much longer explanation: reimplementing the 'Timeout' using an API Timer Callback. As the author of that answer, I should warn you that this is using a sledgehammer to crack a nut after attempting the task with a prolonged naval bombardment.
I have tried the following code to control VBA msg box auto closer after 40 sec. You can try also it. It will work for you.
'The first part
#If Win64 Then '64?
Private Declare PtrSafe Function MsgBoxTimeout _
Lib "user32" _
Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As LongPtr, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As VbMsgBoxStyle, _
ByVal wlange As Long, _
ByVal dwTimeout As Long) _
As Long
#Else
Private Declare Function MsgBoxTimeout _
Lib "user32" _
Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As VbMsgBoxStyle, _
ByVal wlange As Long, _
ByVal dwTimeout As Long) _
As Long
#End If
'The second part
Sub btnMsgbox(message As String)
Call MsgBoxTimeout(0, message, "", vbInformation, 0, 40000)
End Sub

Excel VBA Shapes TextFrame Characters Text Charset

I insert textbox to my Excel 2013 document and put some text
正体字/繁体字
with UTF-8 symbols
In textbox its looks ok but when I trying to msgbox it with command
MsgBox ActiveSheet.Shapes("Textbox 1").TextFrame.Characters.Text
I get something like
???/???
So how to set UTF_8 charset to get normally this text in msgbox or into variable?
You can create something that looks like a MsgBox and functions like a MsgBox, but can better handle UniCode:
Public Declare Function MessageBoxU Lib "user32" Alias "MessageBoxW" _
(ByVal hwnd As Long, _
ByVal lpText As Long, _
ByVal lpCaption As Long, _
ByVal wType As Long) As Long
Sub MsgBoxSubstitute()
Dim s As String
s = ChrW(8451)
MessageBoxU 0, StrPtr(s), StrPtr("MsgBox Substitute"), 0
End Sub
Using the Windows API. Note it has a nice built-in mechanism to dismiss the message.
The only workaround is to create a form and display your message in a label. I think labels are UTF-8 enabled.

VBA - Go to website and download file from save prompt

I've been spending the last few hours trying to figure out how to save a file onto the computer using VBA. The code template below that I found on another forum seems promising, except when I go to the desktop to access it, the .csv file has what looks like the page's source code instead of the actual file I want. This may be because when I go to the URL, it doesn't automatically download the file; rather, I am asked to save the file to a certain location (since I don't know the path name of the uploaded file on the site).
Is there any way to alter this code to accommodate this, or will I have to use a different code entirely?
Sub Test()
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
MyFile = "MY_URL_HERE"
WHTTP.Open "GET", MyFile, False
WHTTP.send
FileData = WHTTP.responseBody
Set WHTTP = Nothing
If Dir("C:\Users\BLAHBLAH\Desktop", vbDirectory) = Empty Then MkDir "C:\Users\BLAHBLAH\Desktop"
FileNum = FreeFile
Open "C:\Users\BLAHBLAH\Desktop\memberdatabase.csv" For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
End Sub
Cross posts:
http://www.ozgrid.com/forum/showthread.php?t=178884
http://www.excelforum.com/excel-programming-vba-macros/925352-vba-go-to-website-and-download-file-from-save-prompt.html
I found over the years more ways how to save/download data using vba:
The firs option witch I prefer and would recommend is to use the URLDownloadToFile function of the user32 library using the following solution
The second one which was also mentioned be yourself. The point here is to use the Microsoft WinHTTP Services (Interop.WinHttp) COM library. In order to achieve this you can also add the Interop.WinHttp reference to your project link. After that you are able to use simpler notation like here link
The third option I aware is to ask the browser to save it for us and then using the Save_Over_Existing_Click_Yes function was mentioned by Santosh. In this case we open an Internet Explorer using the COM interface and navigate to the proper site. So we have to add the Microsoft Internet Controls (Interop.SHDocVw) and the Microsoft HTML Object Library (Microsoft.mshtml) references to our project in order to gain intellisense feature of the editor.
I don't like this download method because this is a work around by hacking. BUT if your IE session was already established authenticated etc. this gonna work nicely. The save function of the Internet Controls was dropped because of security concern. See for example: link
Newer the less you have to have the correct url to download what you want. If you pick the wrong one you will download something else :)
So please try to make sure the the url you use is correct by enter it in a browser. If it opens the right .csv file than your source could work too.
Also please try to send some more information: for example the url to the .csv file
Try below code :
Copied from here (Not tested)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Sub Save_Over_Existing_Click_Yes()
Dim hWnd As Long
Dim timeout As Date
Debug.Print "Save_Over_Existing_Click_Yes"
'Find the Download complete window, waiting a maximum of 30 seconds for it to appear. Timeout value is dependent on the
'size of the download, so make it longer for bigger files
timeout = Now + TimeValue("00:00:30")
Do
hWnd = FindWindow(vbNullString, "Save As")
DoEvents
Sleep 200
Loop Until hWnd Or Now > timeout
Debug.Print " Save As window "; Hex(hWnd)
If hWnd Then
'Find the child Close button
hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
Debug.Print " Yes button "; Hex(hWnd)
End If
If hWnd Then
'Click the Close button
SetForegroundWindow (hWnd)
Sleep 600 'this sleep is required and 600 miiliseconds seems to be the minimum that works
SendMessage hWnd, BM_CLICK, 0, 0
End If
End Sub