I am trying to make a part in my routine which retrieves a .xls document from a FTP location.
I have been googling for quite a few hours now and I am starting to get quite frustrated with this piece of code.
When running the code I get Run-Time error '3001' saying that my arguments are either of the wrong type and are out of the aceptable range, or are in conflict with one another.
Sub GetFTPFile()
Dim objXML
Dim strFTPResponse
Dim varUser, varPassword As Variant
Dim LocalDir As String
Set objXML = CreateObject("MSXML2.XMLHTTP")
strURL = "ftp://xyz_hourly.xls"
LocalDir = "c//"
varUser = "xxx"
varPassword = "yyy"
Call objXML.Open("GET", strURL, varUser, varPassword, False)
Call objXML.send
Do While objXML.readystate <> 4
DoEvents
Loop
Set File = CreateObject("ADODB.Stream")
File.Type = 1
File.Open
File.Write objXML.ResponseBody
File.SaveToFile "c//yyy.xlsx", 2
End Sub
Related
The asterisks indicate where the error is occuring
Below is he code that I am using
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = Range("Item_ID").Row And _
Target.Column = Range("Item_ID").Column Then
Dim ie As New InternetExplorer
'Set IE.Visible
ie.Visible = True
***ie.navigate "https://portal.shiptrackapp.com/Admin/reports.aspx?records=" & Range("Item_ID").Value***
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = ie.document
Dim odd As String
odd = Trim(Doc.getElementsByClassName("odd")(1).innerText)
ie.Quit
Dim aodd As Variant
aodd = Split(sodd, ",")
Range("Tracking_Number").Value = aodd(3)
Range("Item_ID").Value = aodd(0)
Range("pick_up_date").Value = aodd(2)
Range("Delivery_Status_Date").Value = aodd(3)
Range("Time").Value = aodd(4)
Range("Delivery_Driver_Name").Value = aodd(5)
Range("Status").Value = aodd(6)
Range("Stats_des").Value = aodd(7)
Range("Comments").Value = aodd(8)
Range("Signed_By").Value = aodd(9)
Range("Del_Add").Value = aodd(10)
Range("History").Value = aodd(11)
Range("Transaction_ID").Value = aodd(12)
Range("ScanCode_dt").Value = aodd(13)
Range("Company_Name").Value = aodd(14)
Range("Def_loc_id").Value = aodd(15)
Range("Dri_cmmts").Value = aodd(16)
Range("creation_dt").Value = aodd(17)
Range("scan_type").Value = aodd(18)
End If
End Sub
You may have modelled your code on this site, where the syntax appears 100% identical with yours.
Dim ie As New InternetExplorer
Dim doc As New HTMLDocument
Dim ecoll As Object
ie.Visible = True
ie.navigate "http://demo.guru99.com/test/web-table-element.php"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set doc = ie.documen
The line of code that gives the trouble has a concatenated string. I suggested you eliminate that and try your code with a hard-coded string as shown above. If that works the problem must be caused by the concatenation: either the variable read from the worksheet or the concatenation syntax itself. Please do the first test first.
I don't use IE myself. Here is working code I use every day. Note that the argument HTMLdoc is a return object. It is passed to the function empty, the function fills it up and the calling procedure receives it back.
Function GetHTMLDoc(ByVal Site As Nur, _
HTMLdoc As MSHTML.HTMLDocument, _
Optional Secty As String) As Boolean
' NIC 003 ++ 10 Aug 2020
' return Not True if the site couldn't be reached
Dim URL As String
Dim Response As String
URL = StoredURL(Site, Secty)
' URL is a string like "https://portal.shiptrackapp.com/Admin/reports.aspx?records=MAA12345"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False ' not asynchronous
On Error GoTo NoURL
.Send
Response = StrConv(.responseBody, vbUnicode)
End With
On Error GoTo 0
Set HTMLdoc = New HTMLDocument
HTMLdoc.Body.innerHTML = Response
GetHTMLDoc = True
Exit Function
NoURL:
Msg.InfoBox "NoURL", 0, vbInformation, URL ' this is a MsgBox
Err.Clear
End Function
You may like to google for the "MSXML2.XMLHTTP" object to find code that handles the HTMLdocument. Basically, "MSXML2.XMLHTTP" connects to the Internet without the use of a browser. However, changing the system shouldn't solve your problem because that lies with the variable URL (in my code) which you will need in whichever system you deploy. Therefore I recommend that you try your existing code without the concatenation.
To take this one step further: If the hard-coded string also fails then the problem might be with the IE. You may have to load a reference library (DLL) to use it. In that case the surprise would be that no error occurs at ie.Visible = True or even Dim ie As New InternetExplorer and the possibility of using another system appears in a new light.
Public myHTTP As MSXML2.XMLHTTP60
Sub SendXML()
Dim response As String
Dim MyXmlHttpHandler As CXMLHTTPHandler
Dim myxml As String
Dim a As String
Dim URL2 As String
Dim FSO As Object
Dim NewFile As Object
Dim XMLFileText As String
If Not myHTTP Is Nothing Then Set myHTTP = Nothing
Set myHTTP = New MSXML2.XMLHTTP60
Set MyXmlHttpHandler = New CXMLHTTPHandler
MyXmlHttpHandler.Initialize myHTTP
myHTTP.OnReadyStateChange = MyXmlHttpHandler
myxml = "D:\1.xml"
myHTTP.Open "get", myxml, True
myHTTP.send (myxml)
a = myHTTP.responseText
URL2=Workbooks("MainSheet.xlsm").Worksheets("OTHERS").Range("I2").Value
If Workbooks("MainSheet.xlsm").Worksheets("OTHERS").Range("h2").Value = vbNullString Or Workbooks("MainSheet.xlsm").Worksheets("OTHERS").Range("h3").Value = vbNullString Then
MsgBox "User not defined server database address or port number...!!!" & vbNewLine & " Failed.."
Exit Sub
End If
myHTTP.Open "POST", URL2, True
myHTTP.send (a)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFile = FSO.CreateTextFile("D:\response.XML", 1, 1)
XMLFileText = ""
NewFile.write (XMLFileText & myHTTP.responseText & vbNewLine) ‘---------error occurred here not printing my response.text in new file.
End Sub
I have already tried on error resume next, it just printing a blank file.
I have also tried on error goto errorhandler
but it also failed saying runtime error dialoge box....
I just want to save response text in a xml file without any error dialouge box..
For future readers
Change the last argument from True to False
myHTTP.Open "POST", myxml, False
Allow time for completion
Is this a large file? Why use async wrapper this way? Why not simple xmlhttp POST request with False argument? – QHarr 8 mins ago
this comment solved my error..... thnks
I'm writing a script where I wish to write an HTML doc to a string from sharepoint.
Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile
Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile
However, I find I get a "path/file access error" every time I run the script for the first time upon boot. Once I visit "\link\to\share.html" in IE for the first time, the path begins to resolve in the VBA script.
My only thought is that IE is performing some sort of "DNS Cache" that VBA can't do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.
As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.
My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don't see this as an elegant solution, and wonder if it will receive the same error any way.
Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There's something weird going on under the hood with resolving that shared domain, and I can't seem to debug it.
See if this helps here and an example below that I used.
2 things though: I only worked with Excel files on Sharepoint and I was already logged in there.
Dim oFSO As Object
'Dim oFolder As Object 'if needed
'Dim oFile As Object 'if needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("\\sharepoint.site.com#SSL\DavWWWRoot\sites\")
'For Each oFolder In oFolder.SubFolders 'loops through folders
' For Each oFile In oFolder.Files 'loops through files
' 'do stuff
' Next oFile
'Next oFolder
I'm a bit confused about what you want to do. Do you want to check out files from SP and check files back into SP?
Sub testing()
Dim docCheckOut As String
'docCheckOut = "//office.bt.com/sites/Training/Design Admin/Training Plan/adamsmacro.xlsm"
docCheckOut = "http://your_path_here/ExcelList.xlsb"
Call UseCheckOut(docCheckOut)
End Sub
Sub UseCheckOut(docCheckOut As String)
' Determine if workbook can be checked out.
If Workbooks.CanCheckOut(docCheckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
Or...do you want to list files in a SP folder?
Sub ListFiles()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
RowCtr = 1
FPath = "http://excel-pc:43231/Shared Documents"
For Each f In FPath
'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
Sub test()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'Set colSubfolders = objFolder.SubFolders
'For Each objSubfolder In colSubfolders
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
'Next
End Sub
I am trying to download all the csv files from a specific website by using excel vba
Following is the code i have prepared :
Sub Gettable()
Dim URL As String
Dim ie As Object
Dim ieDoc As Object
Dim sel_day As Variant
URL = "http://www.bseindia.com/markets/equity/EQReports/BhavCopyDebt.aspx?expandable=3"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate URL
Do Until (ie.readyState = 4 And Not ie.Busy)
DoEvents
Loop
Set ieDoc = ie.document
'============================================================================
ieDoc.getElementsByTagName("Select")("fdate1").Options("02").SelectIndex
'============================================================================
'ie.Quit
'Set ie = Nothing
'Set ieDoc = Nothing
End Sub
Now the problem i am facing here is i am not able to change the contents dropdown box(to form a date).
I have already tried lots of solutions from stackoverflow as well as other websites but havent got any success. i have good programming knowledge but am stuck at this point the whole day. Any help would be appreciated. thanks in advance :)
All i wanted in the end was to download all csv files. I figured out an alternative solution in the mean time to download the csv file but would still appreciate if someone gives a solution to this issue i had posted above... :)
My alternative Solution as follows :
Sub try10() 'Took me 10 tries by the way :)
Dim NoOfDays As Long, i As Long
Dim MyDate As Variant
'Since the minimum date can't be less #1/1/2007# so lets loop until Mydate reaches #1/1/2007#.
NoOfDays = Date - #1/1/2007#
For i = 0 To NoOfDays
MyDate = Format((Date - i), "ddmmyy")
Dim myURL As String
myURL = "http://www.bseindia.com/download/BhavCopy/Equity/eq" & MyDate & "_csv.zip"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
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\X\Desktop\BhavCopies\eq" & MyDate & "_csv.zip")
oStream.Close
End If
Next
End Sub
This solution however produces a 211kb fake file for csv's that don't exist which can be dealt with manually . :) ;)
The items you are trying to control are in an iframe. To get to the HTML inside the iframe, extract the src attribute from the tag and navigate to the URL formed by that src and the base URL. In this case the src is "Equitydebcopy.aspx", so if you navigate to "http://www.bseindia.com/markets/equity/EQReports/Equitydebcopy.aspx" you'll find that the following lines will allow you to get the information you want.
ie.document.getElementByID("fdate1").Value = "15"
ie.document.getElementByID("fmonth1").Value = "1"
ie.document.getElementByID("fyear1").Value = "2014"
ie.document.getElementByID("btnSubmit").Click
I searched SO, SU, and SP.SE for a solution, but could not find what I needed. I'm looking for a solution which may be a script or some other non-coding method/tool.
I am trying to write a script (to be used by others) or some other form of automation to upload various reports automatically to a SharePoint site. I have managed to get the following (VBScript) code to work, but only for text-based files -- .CSV in this case, though this also works for .TXT, etc.
Option Explicit
Dim sCurPath
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
UploadAllToSP sCurPath
Sub UploadAllToSP(sFolder)
Dim fso, folder, fil
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)
For Each fil In folder.Files
If fso.GetExtensionName(fil) = "csv" Then
UploadFileToSP fil
End If
Next
End Sub
Sub UploadFileToSP(ofile)
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Set tsIn = ofile.openAsTextstream
sBody = tsIn.readAll
tsIn.close
sharepointUrl = "http://SHAREPOINT URL HERE"
sharepointFileName = sharepointUrl & ofile.name
set xmlHttp = createobject("MSXML2.XMLHTTP.4.0")
xmlhttp.open "PUT", sharepointFileName, false
xmlhttp.send sBody
If xmlhttp.status < 200 Or xmlhttp.status > 201 Then
wscript.echo "There was a problem uploading " & ofile.name & "!"
End If
End Sub
This only works for text files because it pipes the text data into a file on the SP site. However, if I want to transfer any kind of binary file (.XLS, .PDF), this results in garbage being uploaded.
I tried to take a look at a Shell.Application ==> .Namespace(), but this doesn't seem to work with a URL, but only a physical drive. Here's some of what else I tried (trimmed to show relevant pieces):
Set oApp = CreateObject("Shell.Application")
If oApp.NameSpace(sharepointUrl) <> Null then ' Always Null!
' Copy here
' Some lines omitted
oApp.NameSpace(sharepointUrl).CopyHere ofile.Name ' This also fails when not surrounded by the Null check
Else
MsgBox "SharePoint directory not found!"
End If
I also tried a batch file using xcopy, but that can't connect to the http:// either. I looked at this method, which may work for me, but I'd prefer not to deal with mapping/NET USE, since our company has multiple network shares, the mapping for which varies depending on who's logged in.
Since none of these work quite the way I need: Is there a method to automate this kind of functionality?
I have experience with VBA/VBscript, so either a script like the above, or something built in to an MS Office application (Outlook is best, but I can probably adapt whatever I am given) would be preferable. That being said, I am open to any method that would allow me to do this, running natively in Windows or Office. However, I do not have access to Visual Studio, so I can't use any .NET functionality.
Thanks to Sean Cheshire for pointing me at the obvious answer that I did not see. Posting the relevant code, since I don't believe this yet exists on SO.
Sub UploadFilesToSP(sFolder)
Dim sharepointUrl
Dim sharepointFileName
Dim LlFileLength
Dim Lvarbin()
Dim LobjXML
Dim LvarBinData
Dim PstrFullfileName
Dim PstrTargetURL
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
'This has not been successfully tested using an "https" connection.
sharepointUrl = "http://SHAREPOINT URL HERE"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(sFolder)
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = sFolder & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointFileName
' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False
' Send the file in.
LobjXML.Send LvarBinData
Next f
Set LobjXML = Nothing
Set fso = Nothing
End Sub
This is VBA code, formatted to mostly work with VBScript, though I could not get this block to transfer properly. As VBA, this can be improved some by assigning data types, etc.
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
This is a very old post but a very useful one so thanks to everyone's contribution. This is my version with the early binding. I found that the previous posting didn't work due to VBA assumption of the none declared variable types.
Private Sub cmdUploadToApplicationsAndApprovals_Click()
Dim strSharePointUrl As String
Dim strSharePointFileName As String
Dim lngFileLength As Long
Dim bytBinary() As Byte
Dim objXML As XMLHTTP
Dim varBinData As Variant
Dim strFullfileName As String
Dim strTargetURL As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim folder As folder
Dim file As file
Dim strFolder As String
strFolder = CurrentProject.Path & "\Upload\"
'This has not been successfully tested using an "https" connection.
strSharePointUrl = "http://sps.mysite.ca/subsite/DocLib/"
Set objXML = New XMLHTTP 'CreateObject("Microsoft.XMLHTTP")
Set folder = fso.GetFolder(strFolder)
For Each file In folder.Files
strSharePointFileName = strSharePointUrl & file.Name
strFullfileName = strFolder & file.Name
lngFileLength = FileLen(strFullfileName) - 1
'Read the file into a byte array.
ReDim bytBinary(lngFileLength)
Open strFullfileName For Binary As #1
Get #1, , bytBinary
Close #1
'Convert to variant to PUT.
varBinData = bytBinary
strTargetURL = strSharePointFileName
'Put the data to the server, false means synchronous.
objXML.Open "PUT", strTargetURL, False
'Send the file in.
objXML.Send varBinData
'Now Update the metadata
Next file
'Clean up
Set objXML = Nothing
Set fso = Nothing
MsgBox "Done"
End Sub
FYI the above code required 2 references.
1. Microsoft XML, v6.0
2. Microsoft Scripting Runtime
Hope this helps improve on the already brilliant answer!!