UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Outlook VBA Issue, Any Version    
 
   
craigsmajors
post Dec 10 2018, 09:37 AM
Post#1



Posts: 1
Joined: 10-December 18



Hello, I have an Outlook VBA script that is triggered to download a file from a link in an email that I get sent daily (the email contains a hyperlink that changes, I have attached a screenshot of what it looks like).
We are switching from Windows 7 Outlook 14, to Windows 10 Outlook 16. It works on my old PC fine, but does not work on the new one. I have already added the run script function back into the registry.


On the windows 10 machine I get "Run-time error 5: Invalid procedure call or argument"
On the debug menu it highlights the line with " WinHttpReq.Open "GET", Mid(myURL, 2, Len(myURL) - 2), False ', "username", "password""

Let me know if there is any further information that is needed.
Thank you.


This is the code that it is using.
----------
Sub LaunchURL(itm As Outlook.MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
Dim myURL As String
Dim FileURL As String

bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)

For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
If Right(splitWord, 8) = "Download" Then
FileURL = Left(splitWord, Len(splitWord) - 8)
'Debug.Print FileURL
myURL = Trim(FileURL)
Call DownloadFile(myURL)
End If
Next
Next
Set itm = Nothing
End Sub

Public Function DownloadFile(tmpURL As String)
Dim myURL As String
Dim WinHttpReq As Object

myURL = tmpURL

Set WinHttpReq = CreateObject("WINHTTP.WinHTTPRequest.5.1")
WinHttpReq.Open "GET", Mid(myURL, 2, Len(myURL) - 2), 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 "\\ineprwf02.pubedu.hegn.us\User\Applications\Inventory\CHR\DailyInbound.csv", 2
' 1 = no overwrite, 2 = overwrite
oStream.Close
End If


End Function
----------
Attached File(s)
Attached File  email.png ( 11.8K )Number of downloads: 2
 
Go to the top of the page
 
cheekybuddha
post Dec 10 2018, 09:48 AM
Post#2


UtterAccess VIP
Posts: 11,689
Joined: 6-December 03
From: Telegraph Hill


welcome2UA.gif

I guess you are missing a reference to the WinHTTP object library.

In the VBA editor go to Tools->References and see if any are listed as missing.

Either try and locate the correct dll, or you might be able to use late-binding and forget about the reference altogether.

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
cheekybuddha
post Dec 10 2018, 09:51 AM
Post#3


UtterAccess VIP
Posts: 11,689
Joined: 6-December 03
From: Telegraph Hill


OK, I see it's late-bound already! blush.gif

Perhaps try a different object library.

Try substituting:
CODE
' ...
  Set WinHttpReq = CreateObject("WINHTTP.WinHTTPRequest.5.1")
' ...

with:
CODE
' ...
  Set WinHttpReq = CreateObject("MSXML2.XMLHTTP.6.0")
' ...


hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
DanielPineault
post Dec 10 2018, 09:54 AM
Post#4


UtterAccess VIP
Posts: 6,963
Joined: 30-June 11



What about trying using Microsoft.XMLHTTP instead?
Does your project compile?



--------------------
Daniel Pineault (2010-2019 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
JonSmith
post Dec 10 2018, 11:05 AM
Post#5


UtterAccess VIP
Posts: 4,053
Joined: 19-October 10



Test using this function with the URL on your new machine.
Its from here in UA but the direct link is no longer valid.

CODE
' DownloadBinary
' http://www.UtterAccess.com/wiki/index.php/DownloadBinary
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2012-01-17
'
Public Function DownloadBinary( _
   src As String, _
   dest As String, _
   Optional TimeoutMS As Long = 45000, _
   Optional ByRef Header As String _
   ) As Long
'Currently provides no validation for src or dest
'prelim version
'returns 0 on success
'returns -1 on timeout
'returns httpRequestStatus on other errors

Const HTTPREQ_TIMEOUT_CHECK = 50

Dim req As Object
Dim lTimer As Long
Dim bFlag As Boolean
Dim bTimeout As Boolean

Dim vBytes As Variant
Dim bBytes() As Byte

Dim iFile As Integer

Set req = CreateObject("MSXML2.XMLHTTP.3.0")
req.Open "GET", src, True
req.send

'timeout
While bFlag = False
   DoEvents: DoEvents: DoEvents
   If req.ReadyState <> 4 Then
     'not done
     If lTimer >= TimeoutMS Then
       bFlag = True
       bTimeout = True
     End If
   Else
     bFlag = True
   End If
   'Sleep HTTPREQ_TIMEOUT_CHECK
   lTimer = lTimer + HTTPREQ_TIMEOUT_CHECK
Wend

If bTimeout Then
   DownloadBinary = -1 'timeout
Else
   If req.Status = 200 Then
    
     Header = req.getAllResponseHeaders()
  
     vBytes = req.responseBody

     ReDim bBytes(0 To UBound(vBytes))
     bBytes = vBytes
    
     iFile = FreeFile()
     Open dest For Binary Access Write As #iFile
     Put #iFile, , bBytes
     Close #iFile
    
     DownloadBinary = 0
    
   Else
     DownloadBinary = req.Status
   End If
End If

Set req = Nothing

End Function
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    18th November 2019 - 04:32 AM