I need to do a one time download of a pipe deliminated text file in VBA. I have tried many of the solutions in other stack overflow questions but I can't seem to make any of the solutions work. It's from the internal wiki page of my firm.
The file is something like: https://wiki.somecompany/downloads/attachments/data.txt
Note: that is not a real url
Edit: I am working within excel.
I am extremely new to VBA, so the solutions I read will probably work but they were not idiot proof.
I tried many things, but the most promising looking were the solutions posted here: EXCEL VBA - To open a text file from a website
I stopped working with the first one because it seemed like you needed Mozilla for that one, and I did not know how to specify Chrome.
I messed around with the open workbook option, but I kept getting a compile error that said "Expected: =" but I don't know what the problem is or where it should be.
Edited: #Tim Williams - your solution is the closest to have anything at all happen besides just VBA errors. I got as far as turning my spreadsheet into a log in page, so I guess I need to pass a username and password somehow
You should be able to turn on the Macro Recorder and get what you want pretty quickly. In fact, you probably spent 10x more time describing the scenario, then it would take to record the code you need. Although, it is possible that you actually can't import the data using the Macro Recorder. You should still be able to import the data by referencing a CSV, which I believe is the exact same thing as a Text file.
Sub Import_CSV_File_From_URL()
Dim URL As String
Dim destCell As Range
URL = "http://www.test.com/test.csv"
Set destCell = Worksheets("test").Range("A1")
With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & URL, Destination:=destCell)
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
destCell.Parent.QueryTables(1).Delete
End Sub
If that doesn't work for you, simply download the file, and do the import from your hard-drive.
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
Sub DownloadFilefromWeb()
Dim strSavePath As String
Dim URL As String, ext As String
Dim buf, ret As Long
URL = Worksheets("Sheet1").Range("A2").Value
buf = Split(URL, ".")
ext = buf(UBound(buf))
strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If ret = 0 Then
MsgBox "Download has been succeed!"
Else
MsgBox "Error"
End If
End Sub
Related
I would like to write a macro that will retrieve a file from our SharePoint and paste it in a special location for every user that runs the macro. I've used the following code to download the file
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
Sub Button1_Click()
DownloadFileFromWeb = URLDownloadToFile(0,
"https://our.sharepoint.com/sharedFolder/file.pptx", "C:\Users\User\folder\myfile.pptx", 0, 0)
Debug.Print DownloadFileFromWeb
End Sub
Code from: How to download a file from Sharepoint with VBA
The value returned by URLDownloadFile is 0, but when I open the file PowerPoint is asking me to repair it. Ideally, I would like users to simply log into SharePoint and then use this macro to download a fresh copy of the shared file. My guess is that it has to do with authentication but I'm not sure how to solve this problem as I don't have much experience in this area. I would definitely not want to prompt for credentials and pass them on as plain text to a function nor do I want the user to hard code them somewhere. I would prefer for the user to sign in into SharePoint and the code to do the rest. Any help on the matter would be greatly appreciated.
EDIT:
I've also tried using the following code producing the same corrupt file. It looks like credentials may not be the problem.
Dim myURL As String
myURL = "https://our.sharepoint.com/sharedFolder/file.pptx"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\Users\User\folder\myfile.pptx", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
EDIT2:
I tried mapping the drive using various commands including net use and New-psdrive without any luck - I still fail to authenticate. Here's a PowerShell command and its output
net use S: '\\out.sharepoint.com/Shared Library' password /USER:me#domain.us
System error 1244 has occurred.
The operation being requested was not performed because the user has not
been authenticated.
I've got this issue yesterday and nothing seemed to work. So I added one row:
Workbooks.Open Filename:=myURL
after setting URL address and macro now works perfectly now.
I think I've stumbled upon a bug in Excel - I'd really like to verify it with someone else though.
The bug occurs when reading the Workbook.VBProject.HelpFile property when the workbook has been opened with the opening application's .AutomationSecurity property set to ForceDisable. In that case this string property returns a (probably) malformed Unicode string, which VBA in turn displays with question marks. Running StrConv(..., vbUnicode) on it makes it readable again, but it sometimes looses the last character this way; this might indicate that the unicode string is indeed malformed or such, and that VBA therefore tries to convert it first and fails.
Steps to reproduce this behaviour:
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a new code module and add some code to it (like e.g. Dim a As Long)
Enter the project's properties (menu Tools... properties)
Enter "description" as Project description and "abc.hlp" as Help file name
Save the workbook as a .xlsb or .xlsm
Close the workbook
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a fresh new code module
Paste the code below in it
Adjust the path on the 1st line so it points to the file you created above
Run the Test routine
The code to use:
Const csFilePath As String = "<path to your test workbook>"
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
Conclusion when working from Excel 2010:
.Description is always readable, no matter what (so it's not like all string properties behave this way)
xlsb and xlsm files result in an unreadable .HelpFile only when macros are disabled
xls files result in an unreadable .HelpFile in all cases (!)
It might be even weirder than that, since I swear I once even saw the questionmarks-version pop up in the VBE GUI when looking at such a project's properties, though I'm unable to reproduce that now.
I realize this is an edge case if ever there was one (except for the .xls treatment though), so it might just have been overlooked by Microsoft's QA department, but for my current project I have to get this working properly and consistently across Excel versions and workbook formats...
Could anyone else test this as well to verify my Excel installation isn't hosed? Preferably also with another Excel version, to see if that makes a difference?
Hopefully this won't get to be a tumbleweed like some of my other posts here :) Maybe "Tumbleweed generator" might be a nice badge to add...
UPDATE
I've expanded the list of properties to test just to see what else I could find, and of all the VBProject's properties (BuildFileName, Description, Filename, HelpContextID, HelpFile, Mode, Name, Protection and Type) only .HelpFile has this problem of being mangled when macros are off.
UPDATE 2
Porting the sample code to Word 2010 and running that exhibits exactly the same behaviour - the .HelpFile property is malformed when macros are disabled. Seems like the code responsible for this is Office-wide, probably in a shared VBA library module (as was to be expected TBH).
UPDATE 3
Just tested it on Excel 2007 and 2003, and both contain this bug as well. I haven't got an Excel XP installation to test it out on, but I can safely say that this issue already has a long history :)
I've messed with the underlying binary representation of the strings in question, and found out that the .HelpFile string property indeed returns a malformed string.
The BSTR representation (underwater binary representation for VB(A) strings) returned by the .HelpFile property lists the string size in the 4 bytes in front of the string, but the following content is filled with the ASCII representation and not the Unicode (UTF16) representation as VBA expects.
Parsing the content of the BSTR returned and deciding for ourselves which format is most likely used fixes this issue in some circumstances. Another issue is unfortunately at play here as well: it only works for even-length strings... Odd-length strings get their last character chopped off, their BSTR size is reported one short, and the ASCII representation just doesn't include the last character either... In that case, the string cannot be recovered fully.
The following code is the example code in the question augmented with this fix. The same usage instructions apply to it as for the original sample code. The RecoverString function performs the needed magic to, well, recover the string ;) DumpMem returns a 50-byte memory dump of the string you pass to it; use this one to see how the memory is layed out exactly for the passed-in string.
Const csFilePath As String = "<path to your test workbook>"
Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Function DumpMem(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
Dim dump As String
Dim offset As Long
For offset = -4 To 50
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
dump = dump & Right("00" & Hex(nextByte), 2) & " "
Next
DumpMem = dump
End Function
Function RecoverString(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
If textAddress <> 0 Then
Dim textSize As Long
Call CopyMemoryDWord(textSize, textAddress - 4, 4)
Dim recovered As String
Dim foundNulls As Boolean
foundNulls = False
Dim offset As Long
For offset = 0 To textSize - 1
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
If nextByte = 0 Then
foundNulls = True
End If
Next
Dim isNotUnicode As Boolean
isNotUnicode = isNotUnicode Mod 2 = 1
If foundNulls And Not isNotUnicode Then
recovered = ""
For offset = 0 To textSize - 1 Step 2
Dim nextWord As Integer
Call CopyMemoryWord(nextWord, textAddress + offset, 2)
recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
Next
End If
End If
RecoverString = recovered
End Function
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
I'm on a quest to figure out how to identify different icon overlays through Excel VBA.
There is a cloud syncing software and I am trying to identify whenever the syncing of my excel file has finished or still in progress. I was able to achieve a basic level of reliability by following the modification date of some meta(?) files but there is not enough consistency to fully rely on this method.
The result of my searches is a big punch in the face, since there is not much info about it in VBA. Basically all I have found that everyone uses advanced languages like C++ to handle these things.
The closest source I've got in VBA does something similar with the System Tray and uses the shell32.dll calling the appropiate windows api (link). But I have no idea how to make it to the Shell Icon Overlay Identifier.
What do you guys think, is there a possible way to make it through VBA or I have to learn C++?
Awesome! It is possible! The SHGetFileInfo method works!
It gives me values according to the current overlays. Here is the code for any other crazy people who wanna mess around with it:
Const SHGFI_ICON = &H100
Const SHGFI_OVERLAYINDEX = &H40
Const MAX_PATH = 260
Const SYNCED = 100664316 'own specific value
Const UNDSYNC = 117442532 'own specific value
Private Type SHFILEINFO
hIcon As Long 'icon
iIcon As Long 'icon index
dwAttributes As Long 'SFGAO_ flags
szDisplayName As String * MAX_PATH 'display name (or path)
szTypeName As String * 80 'type name
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Sub GetThatInfo()
Dim FI As SHFILEINFO
SHGetFileInfo "E:\Test.xlsm", 0, FI, Len(FI), SHGFI_ICON Or SHGFI_OVERLAYINDEX
Select Case FI.iIcon
Case SYNCED
Debug.Print "Synchronized"
Case UNDSYNC
Debug.Print "Synchronization in progress"
Case Else
Debug.Print "Some shady stuff is going on!"
End Select
End Sub
Thanks for the tip again!
Is there any way to check NEtwork connection in vba?
I am using this command:
If Dir("O:\") = "" Then
MsgBox "you have network connection"
Else
MsgBox "No Connection"
End If
but it doesnt work and I am getting a run time error
What you are doing is almost correct except flip the if and else parts,
i.e. when Dir("O:\") = "" = You are not connected
and when it returns something means you have a connection.
The Dir function is used to return the first filename from a specified directory, and list of attributes.
Sub Test_Connection()
If (Len(Dir("O:\"))) Then
MsgBox "Connected"
Else
MsgBox "No Connection"
End If
End Sub
This is similar to St3ve's answer, but in function form that returns True if the drive is connected, and False if not.
Function TestNetwork() As Boolean
On Error Resume Next 'ignore errors
If Len(Dir("O:\", vbDirectory)) = 0 Then
TestNetwork = False
Else
TestNetwork = True
End If
On Error GoTo 0 'reset error handling
End Function
I found that the Len(Dir("O:\")) method works for external drives, like a flash disk, but didn't work for a mapped network drive. The function works around this with On Error Resume Next, so if O:\ is a disconnected mapped drive, the system hides the Error 52 and goes to the TestNetwork = False line.
Call the function in your code like this:
If TestNetwork() = True Then
'Code if connected
Else
'Code if not connected
End If
You can generalize this code to test different directories by naming the function Function TestNetwork(DirAddress As String) As Boolean and replace "O:\" with DirAddress. Then use TestNetwork("O:\"), or any other directory address in quotes when you call it.
I tested the solution from this link in Access 2007 VBA.
http://www.vbaexpress.com/forum/showthread.php?42466-Pinging-IP-addresses-in-Access-2007
It works as a function call that can be used anywhere in your VBA code to detect the availibility of a network resource by name or IP and reuturn a boolean value as the result.
I don't know if your problem is solved. Anyway I had a similar issue using Excel VBA.
Having a diskstation on my network, I mapped a shared folder of this station as a network folder in Windows, using letter M. Generally, after starting my Windows, and of course diskstation is up and running, the network drive shows in Windows Explorer, but it has a red cross (not connected) instead of the icon with some green color (connected). Only after I manually click this network location in Explorer it becomes green. I first expected the connection could also be established via my Excel VBA programs, when issuing the first time a statement like Dir("M:\abc"). However there is no result, and the icon remains red. I always needed first to click manually in Explorer.
Finally I found a solution in VBA, using prior to the Dir a dummy "shellexecute ... explore M: ...", making the network drive automatically connected.
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
'...
Dim RetVal As Long
Dim hwnd As Long
RetVal = ShellExecute (hwnd, "explore", "M:", vbNullString, vbNullString, SW_SHOWNOACTIVATE)
'...
a = Dir("M:\abc")
I know this is a very old question and that my answer is not super clean (cause it uses a label), but I find it really simple and reliable.
Instead of using DLL files I just wanted to let the code run past the 52 runtime error, so I used a 'on error goto' and a label.
This way if the folder is not available, you don't get the error message (which was unacceptable for me, since I needed others to use the macros comfortably), the code just falls into the IF statement, where I thought it would go if the len function returned a 0.
On Error GoTo len_didnt_work 'this on error handler allow you to get past the 52 runtime error and treat the situation the way you want, I decided to go with a msgbox and to stop the whole sub
If Len(Dir("O:\Test\**", vbDirectory)) = 0 Then 'this is the test others have proposed, which works great as long as the folder _is_ available. If it is not I'd always just get the 52 runtime error
len_didnt_work: 'this is the label I decided to use to move forward in the code without the runtime 52 error, but it is placed inside the IF statement, it just aids it to work 'properly' (as I'd expect it to)
MsgBox "Sorry, your folder is not available",vbcritical 'msgbox to notify the user
On Error GoTo 0 'reset error handling
Exit Sub 'end sub, since I wanted to use files from my "O:\Test\" folder
End If
On Error GoTo 0`'reset error handling in case the folder _was_ available
I want to give an another spin on this as it is the issue.
I use Scripting.FileSystemObject!
The will check is a folder exist and do not require an error handling.
It works with network drive mapped and network folder.
Just will not detect if a network computer is their for example :"\server"
But "\server\folder" or "Y:" is working.
Dim Serverfolder As String
Serverfolder = "O:\"
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists(Serverfolder) = False Then '= False is not needed!
'folder do not exists
else
'Folder exists
End if
I'm trying to open a Chrome browser from VBA. I understand Chrome does not support ActiveX settings so I'm curious if theres any work-arounds?
Dim ie As Object
Set ie = CreateObject("ChromeTab.ChromeFrame")
ie.Navigate "google.ca"
ie.Visible = True
shell("C:\Users\USERNAME\AppData\Local\Google\Chrome\Application\Chrome.exe -url http:google.ca")
Worked here too:
Sub test544()
Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http:google.ca")
End Sub
I found an easier way to do it and it works perfectly even if you don't know the path where the chrome is located.
First of all, you have to paste this code in the top of the module.
Option Explicit
Private pWebAddress As String
Public 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
After that you have to create this two modules:
Sub LoadExplorer()
LoadFile "Chrome.exe" ' Here you are executing the chrome. exe
End Sub
Sub LoadFile(FileName As String)
ShellExecute 0, "Open", FileName, "http://test.123", "", 1 ' You can change the URL.
End Sub
With this you will be able (if you want) to set a variable for the url or just leave it like hardcode.
Ps: It works perfectly for others browsers just changing "Chrome.exe" to opera, bing, etc.
You can use the following vba code and input them into standard module in excel. A list of websites can be entered and should be entered like this on cell A1 in Excel - www.stackoverflow.com
ActiveSheet.Cells(1,2).Value merely takes the number of website links that you have on cell B1 in Excel and will loop the code again and again based on number of website links you have placed on the sheet. Therefore Chrome will open up a new tab for each website link.
I hope this helps with the dynamic website you have got.
Sub multiplechrome()
Dim WebUrl As String
Dim i As Integer
For i = 1 To ActiveSheet.Cells(1, 2).Value
WebUrl = "http://" & Cells(i, 1).Value & """"
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url " & WebUrl)
Next
End Sub
The answer given by #ray above works perfectly, but make sure you are using the right path to open up the file. If you right click on your icon and click properties, you should see where the actual path is, just copy past that and it should work.
You could use selenium basic to launch and interact with Chrome. After installation you will need to add a reference to Selenium Type library.
Option Explicit
Public Sub Demo()
Dim d As WebDriver
Set d = New ChromeDriver
Const URL = "https://www.google.com/"
With d
.Start "Chrome"
.get URL
.FindElementById("lst-ib").SendKeys "Selenium basic GitHub"
.FindElementsByTag("form")(1).FindElementByCss("input[value='Google Search']").Click
'.Quit
End With
End Sub