Basic認証後にExcelファイルをDLするには? 削除
| Message#1 2015年8月24日(月)18時15分 From: cherry |
| 初めまして。過去に同じ質問がございましたら申し訳ございません。 こちらの掲示板の本サイトにてBasic認証でログインするコードを学んだのですが、まだまだ本当に理解できていなくてエラーとなるためご教示いただきたくよろしくお願いいたします。 状況は社内サーバーにWebブラウザ（IE8）でログインしExcelファイルをDLするという動作のVBAなのですが、ExcelファイルはそのURLにアクセスするとDLダイアログが出てしまいます。そのためAPIを使用してダイアログを出ないようにしてDLしようとしたのですが、下記コードだとログインしたらすぐそのダイアログが出てしまい、APIで保存できているのですがWebブラウザを閉じることができないためダイアログを出さないようにしたいです。 コードの位置が間違っているのでしょうか。 Option Explicit #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) #End If Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) 'URLDownloadToFile API from URLMON. 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 Const WS_dl = "DL" Dim WS01 As Worksheet Dim getURL As String Dim dName As String Dim returnValue Sub Macro1() Dim objIE As Object Dim i As Long Dim uName As String Dim pWord As String Dim MaxRow As Long Dim getPath As String Dim getFL As String Dim strIdPw As String Set WS01 = Worksheets(WS_dl) With WS01 .Activate '各項目情報をDLシートより取得 uName = .Range("A2").Value pWord = .Range("B2").Value getPath = .Range("C2").Value MaxRow = .Cells(Rows.Count, 4).End(xlUp).Row For i = 2 To MaxRow Step 1 getURL = .Cells(i, 4).Value 'DLするExcelファイルのURL getFL = .Cells(i, 5).Value 'DLするExcelファイル名 '保存先と保存名の取得 dName = "C:\Users\" & uName & "\Desktop\" & getPath & "\" & getFL 'IEの起動 'Basic認証ページへアクセスする '「ユーザーID:パスワード」をBASE64エンコードする strIdPw = base64(uName & ":" & pWord) Call ieBasic(objIE, getURL, strIdPw) 'URLDownloadToFile API をコールする returnValue = 0 '初期化 'DeleteUrlCacheEntry(getURL) 'キャッシュクリア…DLしてもキャッシュに残らないようなのでコメントアウト returnValue = URLDownloadToFile(0, getURL, dName, 0, 0) objIE.Quit 'IEを閉じる Set objIE = Nothing Next i End With End Sub Private Sub ieBasic(objIE As Object, urlName As String, idPass As String) Dim headValue As String 'IEのオブジェクトを作成する Set objIE = CreateObject("InternetExplorer.Application") 'IEを表示 objIE.Visible = True 'Authorization情報 headValue = "Authorization: Basic " & idPass & vbCrLf '指定したBasicURLのページを表示する objIE.navigate urlName, , , , headValue End Sub ※Function base64は省略しています。 よろしくお願いいたします。 |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。
