人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

VBAについて質問です。

ExcelVBAからIEを開いて、楽天オークションサイトに自動投稿しようとしています。
getElementsByName を使用し画像の出力をしようとしているのですが、出力がどうしてもできず知っているかたおりましたらご回答いただければと思います。

objIE.Document.getElementsByName("img1")(0).Value = "D:\test.jpg"

として画像をアップしようとしてみたのですができませんでした。
間違えたコードになりますが、上記のように getElementsByName の後にできれば 画像場所のURLを書いて登録できるのが理想です。
お手数をおかけしますがわかるかたおりましたらよろしくお願いいたします。

●質問者: aiomock
●カテゴリ:コンピュータ インターネット
✍キーワード:.jpg IE test URL VBA
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● kengo9999q
●23ポイント

もしIE8をご利用でしたらセキュリティ強化の関係でスクリプトを使ってファイル参照関係のValueの変更ができなくなってます。

IE7又はIE6では出来るのでIE8を削除してみては?

◎質問者からの返答

ご回答ありがとうございます。

Versionを確認してみたところIE7でした。

基本的には objIE.Document.getElementsByName("img1")(0).Value = "D:\test.jpg" これであっているということでしょうか?


2 ● pah00
●23ポイント

formのenctype属性を"multipart/form-data"

にしないとだめなのですが、できてますか?

◎質問者からの返答

ご回答ありがとうございます。

enctype属性を"multipart/form-data" にできていないです。

わからないので少し調べてみたいと思います。。


3 ● HALSPECIAL
●100ポイント ベストアンサー

ieオブジェクトを勧めたのはそもそも私です。

(HTML DOMの操作もでき、WEBの操作としてはハードルが低めだと思いましたので)

ですが、input のfileの操作がセキュリティ上厳しいとは知りませんでした。

普段、使ったことがあまりないので、すみませんでした。


対処方法ですが、

レジストリを弄ってセキュリティレベルを落とす等も考えられます。

今回は、不本意なのですが、クリップボードとキー送信を使用したサンプルを

作ってみましたので試してみてください。

Option Explicit

'-----------------------------------------------------------------------------------------
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Boolean
Private Declare Function IsWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

'-----------------------------------------------------------------------------------------
'クリップボード関連のAPI
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long _
 ) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long _
 ) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
 ByVal dwBytes As Long _
 ) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long _
 ) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
 ByVal lpString2 As Any _
 ) As Long
Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, _
 ByVal hMem As Long _
 ) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
 
'-----------------------------------------------------------------------------------------
Private Const READYSTATE_COMPLETE = 4
Private ie
Private hwndIE As Long
 
 
'IEを起動し、ファイルのアップロードをするサンプル(IE8 で動作)
Public Sub FileUpLoadTest()
 
 Dim url
 url = "http://aiomock2008.kage-tora.com/rakuten3.html"
 
  'ieを起動
 Set ie = CreateObject("InternetExplorer.Application")
 ie.Visible = True
  'ウィンドウハンドルをしまっておく
 hwndIE = ie.hwnd
 
  'ページの移動
 ie.Navigate2 url
  '待機
 While ie.ReadyState <> READYSTATE_COMPLETE Or ie.Busy = True
 Sleep 200
 Wend
 
  'ファイル名をクリップボードにセットしておく
 Dim fileName As String
 fileName = "D:\テスト画像.bmp"
 
 Call SetClipBoard(fileName)
 
 Dim document
 Set document = ie.document

  '念のためにieをアクティブにする
 Call SetForegroundWindow(hwndIE)
 
 document.getElementsByName("img1")(0).Select
 
 Application.SendKeys " ", True  '何故か最初にスペースを送信しないとダメらしい
  '↑ここでようやくダイアログが上がる。これが無くても動作するようであれば尚可
 
 Application.SendKeys "^V", True  '貼付
 Application.SendKeys "%O", True  'ALT+O で開くボタンを押す
 
 document.Forms(0).submit 'サブミット

 Set document = Nothing

End Sub

'参考:moug モーグ | 即効テクニック
' クリップボードへデータを送信する方法
' http://www.moug.net/tech/acvba/0020004.htm
Public Function SetClipBoard(MyString As String)
 Dim hGlobalMemory As Long
 Dim lpGlobalMemory As Long
 Dim hClipMemory As Long
 Dim X As Long

  '移動可能なグローバルメモリを割り当て
 hGlobalMemory = GlobalAlloc(GHND, LenB(MyString) + 1)

  'ブロックをロックして、メモリへのfarポインタを取得
 lpGlobalMemory = GlobalLock(hGlobalMemory)

  '文字列をグローバルメモリへコピー
 lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

  'メモリのロックを解除します。
 If GlobalUnlock(hGlobalMemory) <> 0 Then
 MsgBox "メモリのロックを解除できません" & vbCrLf & _
 "処理が失敗しました"
 GoTo OutOfHere2
 End If

  'データをコピーするクリップボードを開く
 If OpenClipboard(0&) = 0 Then
 MsgBox "クリップボードを開くことができません" & vbCrLf & _
 "処理が失敗しました"
 Exit Function
 End If

  ' クリップボードの内容を消去
 X = EmptyClipboard()

  ' データをクリップボードへコピー
 hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
  ' クリップボードの状態チェック
 If CloseClipboard() = 0 Then
 MsgBox "クリップボードを閉じることができません"
 End If
End Function
◎質問者からの返答

ご回答ありがとうございます。試してみます。


4 ● kn1967
●100ポイント

比較してやってください。もちろん自己責任で。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Macro5()
 Const READYSTATE_COMPLETE = 4
 Dim objIE As Object
 Set objIE = CreateObject("InternetExplorer.Application")
 objIE.Visible = True
 
 objIE.Navigate2 "ここにはURLを入れる"
 While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True
 Sleep 200
 Wend
 
 Dim Doc As Object
 Set Doc = objIE.Document
 
 Dim objName(2) As String, fileName(2) As String, waitCount As Long, i As Long
 objName(0) = "img1"
 objName(1) = "img2"
 objName(2) = "img3"
 fileName(0) = "D:\加工済み画像\B\B1\022.jpg": '画像ファイル名をフルパスで書く。3つ全て空白も可能。
 fileName(1) = ""
 fileName(2) = ""
 
 If Len(fileName(0) & fileName(1) & fileName(2)) = 0 Then
 objIE.Document.forms(1).submit: '画像登録無しで次に進む
 Exit Sub: ' 平行して動き続けてしまうので、ここで、このプログラムを抜ける
 End If
 
 For i = 0 To 2: 'IE へのファイル名書き込み
 If fileName(i) <> "" Then
 objIE.Document.getElementsByName(objName(i))(0).Focus: 'フォーカスセット
 SendKeys fileName(i): '文字列送信開始
 waitCount = 10: '下記のループを10回までに制限し、越えたらエラーとする。
 Do: 'Valueにファイル名が正しくセットされるまでループ
 If (objIE.Document.getElementsByName(objName(i))(0).Value = fileName(i)) Then Exit Do
 Sleep 1000
 waitCount = waitCount - 1
 Loop While waitCount >= 0
 If waitCount = -1 Then Exit For: 'タイムアウトは強制的にループを抜ける。
 End If
 Next
 If i < 3 Then
 MsgBox "タイムアウトエラーとなりました。処理は終了します。"
 Exit Sub: ' このプログラムを抜ける
 Else
 objIE.Document.forms(0).submit: ' 画像を転送して、画像確認画面に進む
 Exit Sub: ' 平行して動き続けるので、念のため、ここで、このプログラムを抜ける
 End If
End Sub
◎質問者からの返答

ご回答ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ