WininetによるHTTPログオン後にZIPファイルダウンロード

分類:[その他]

VBA　API　初心者です。非常に困っていますので、アドバイスをいただきたくお願いいたします。

現在、下記の要領でExcelアドインを作成しています。
�@URLを指定して業務システムへ自動でログイン
�AURLを指定してエクセルファイルをダウンロード
�Bその後ファイルを任意の場所に解凍。

とあるサイトを見て、以下のコードを書きましたが
恐らくログインができていないのか、ZIPファイルは取得されますが、
中身のエクセルファイルは数字が入っていない状態です。

↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓　コード開始　↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
'バナー画像のURL
Const url = "http://ダウンロード対象アドレス"

Dim s As String
Dim FileName As String
Dim FileNumber As Integer
Dim hOpen As Long
Dim hConnect As Long
Dim buf() As Byte '動的配列
Dim dwSize As Long
Dim total As Long 'ダウンロード済みのデータのサイズ

'ログイン処理
Call Connect("UserID", "PassWord")

'WinInetを初期化
hOpen = InternetOpen("Excel VBA", INTERNET_OPEN_TYPE_DIRECT, _
vbNullString, vbNullString, 0)

'URLを開く
hConnect = InternetOpenUrl(hOpen, url, vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)

total = 0
ReDim buf(1 To 1000000) '十分な大きさの配列のサイズを確保する

Do
'1024バイトずつデータを取得する

'配列のダウンロード済みのデータの次の要素を渡す
InternetReadFile hConnect, buf(total + 1), 1024, dwSize

'データ取得サイズが0になったら終了
If dwSize = 0 Then
Exit Do
Else
'ダウンロード済みのデータのサイズを計算していく
total = total + dwSize
End If
Loop

'ハンドルを開放
InternetCloseHandle hConnect
InternetCloseHandle hOpen

'動的配列の大きさを再定義
'Preserve を指定してデータが消えないようにする
ReDim Preserve buf(1 To total)

'保存する.gifファイルのパスを取得
'マクロ含むExcelファイルと同じフォルダに保存する
s = ThisWorkbook.FullName
FileName = Left(s, InStrRev(s, "\", , vbBinaryCompare)) & _
"TEST.zip"

'保存用にファイルを開く
FileNumber = FreeFile
Open FileName For Binary Access Write As #FileNumber

'ファイルへ書き込み
Put #FileNumber, , buf

'ファイルを閉じる
Close #FileNumber

'配列を消去
Erase buf

'解凍処理
Call unZip(FileName, ThisWorkbook.Path)
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑　コード終了　↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑


また、ログイン処理はサブモジュールで以下のコードとなっています。

↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓　ログイン処理　↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
Public Function connect(ByVal username As String, ByVal password As String)

Dim Content As String
Dim oJSON As Object

On Error Resume Next

Login = True

Content = "FLogin[username]=" & CStr(username) & _
"&FLogin[password]=" & CStr(password)
Set oJSON = HTTP_Post("http://10.80.237.71/site/login", Content)

end function

Public Function HTTP_Post(url As String, Content As String)

On Error Resume Next

Debug.Print "HTTP_Post:URL:" & url
Debug.Print "HTTP_Post:Content:" & Content
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
xmlhttp.Open "POST", url, False
xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.Send CStr(Content)
Set HTTP_Post = xmlhttp

End Function
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑　ログイン処理終了　↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

VBA初心者であるため、ほとんどWEBからコピーしてきたものですが、HTTP_Postを行った
場合は正常にログインできています。しかし、その後のWininetを利用したURL関連の操作に
ログイン情報が引き継がれていないためログインされていないものとして処理されていると
思われます。このログインをWininetを利用したものに変更するか、もしくは他の方法で
先述の処理ができればと考えています。
※コードを提供していただければ、後はこちらで解析して見ます。