2015-10-21 14 views
5

OCR Siteに画像ファイルをアップロードしようとしていますが、PDFファイルはサイトにアップロードされません。VBAを使用してHTMLフォームの<input input>ファイルをアップロードします

私はそれを達成するために、次のコードを使用して、以下のHTMLセグメントでいます:ここで

Sub DownPDF() 

    Dim FileName As String: FileName = "C:\Users\310217955\Documents\pdfdown\SGSSI001_HL1464_2011.pdf" 
    Dim DestURL As String: DestURL = "https://www.newocr.com/" 
    Dim FieldName As String: FieldName = "userfile" 
    Call UploadFile(DestURL, FileName, FieldName) 

End Sub 


'******************* upload - begin 
'Upload file using input type=file 
Sub UploadFile(DestURL, FileName, FieldName) 
    'Boundary of fields. 
    'Be sure this string is Not In the source file 
    Const Boundary = "---------------------------" 

    Dim FileContents, FormData 
    'Get source file As a binary data. 
    FileContents = GetFile(FileName) 

    'Build multipart/form-data document 
    FormData = BuildFormData(FileContents, Boundary, FileName, FieldName) 

    'Post the data To the destination URL 
    IEPostBinaryRequest DestURL, FormData, Boundary 
End Sub 

'Build multipart/form-data document with file contents And header info 
Function BuildFormData(FileContents, Boundary, FileName, FieldName) 
    Dim FormData, Pre, Po 
    Const ContentType = "application/upload" 

    'The two parts around file contents In the multipart-form data. 
    Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, FileName, ContentType) 
    Po = vbCrLf + "--" + Boundary + "--" + vbCrLf 

    'Build form data using recordset binary field 
    Const adLongVarBinary = 205 
    Dim RS: Set RS = CreateObject("ADODB.Recordset") 
    RS.Fields.Append "b", adLongVarBinary, Len(Pre) + LenB(FileContents) + Len(Po) 
    RS.Open 
    RS.AddNew 
    Dim LenData 
    'Convert Pre string value To a binary data 
    LenData = Len(Pre) 
    RS("b").AppendChunk (StringToMB(Pre) & ChrB(0)) 
    Pre = RS("b").GetChunk(LenData) 
    RS("b") = "" 

    'Convert Po string value To a binary data 
    LenData = Len(Po) 
    RS("b").AppendChunk (StringToMB(Po) & ChrB(0)) 
    Po = RS("b").GetChunk(LenData) 
    RS("b") = "" 

    'Join Pre + FileContents + Po binary data 
    RS("b").AppendChunk (Pre) 
    RS("b").AppendChunk (FileContents) 
    RS("b").AppendChunk (Po) 
    RS.Update 
    FormData = RS("b") 
    RS.Close 
    BuildFormData = FormData 
End Function 

'sends multipart/form-data To the URL using IE 
Function IEPostBinaryRequest(URL, FormData, Boundary) 
    'Create InternetExplorer 
    Dim IE: Set IE = CreateObject("InternetExplorer.Application") 

    'You can uncoment Next line To see form results 
    IE.Visible = True 

    'Send the form data To URL As POST multipart/form-data request 
    IE.Navigate URL, , , FormData, _ 
    "Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf 

    Do While IE.Busy Or IE.readyState <> 4 
    Wait 1, "Upload To " & URL 
    Loop 

    'Get a result of the script which has received upload 
    On Error Resume Next 
    IEPostBinaryRequest = IE.document.body.innerHTML 
    'IE.Quit 
End Function 

'Infrormations In form field header. 
Function mpFields(FieldName, FileName, ContentType) 
    Dim MPTemplate 'template For multipart header 
    MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _ 
    " filename=""{file}""" + vbCrLf + _ 
    "Content-Type: {ct}" + vbCrLf + vbCrLf 
    Dim Out 
    Out = Replace(MPTemplate, "{field}", FieldName) 
    Out = Replace(Out, "{file}", FileName) 
    mpFields = Replace(Out, "{ct}", ContentType) 
End Function 


Sub Wait(Seconds, Message) 
    On Error Resume Next 
    CreateObject("wscript.shell").Popup Message, Seconds, "", 64 
End Sub 


'Returns file contents As a binary data 
Function GetFile(FileName) 
    Dim Stream: Set Stream = CreateObject("ADODB.Stream") 
    Stream.Type = 1 'Binary 
    Stream.Open 
    Stream.LoadFromFile FileName 
    GetFile = Stream.Read 
    Stream.Close 
End Function 

'Converts OLE string To multibyte string 
Function StringToMB(S) 
    Dim I, B 
    For I = 1 To Len(S) 
    B = B & ChrB(Asc(Mid(S, I, 1))) 
    Next 
    StringToMB = B 
End Function 
'******************* upload - end 

'******************* Support 
'Basic script info 
Sub InfoEcho() 
    Dim Msg 
    Msg = Msg + "Upload file using http And multipart/form-data" & vbCrLf 
    Msg = Msg + "Copyright (C) 2001 Antonin Foller, PSTRUH Software" & vbCrLf 
    Msg = Msg + "use" & vbCrLf 
    Msg = Msg + "[cscript|wscript] fupload.vbs file url [fieldname]" & vbCrLf 
    Msg = Msg + " file ... Local file To upload" & vbCrLf 
    Msg = Msg + " url ... URL which can accept uploaded data" & vbCrLf 
    Msg = Msg + " fieldname ... Name of the source form field." & vbCrLf 
    Msg = Msg + vbCrLf + CheckRequirements 
    WScript.Echo Msg 
    WScript.Quit 
End Sub 

'Checks If all of required objects are installed 
Function CheckRequirements() 
    Dim Msg 
    Msg = "This script requires some objects installed To run properly." & vbCrLf 
    Msg = Msg & CheckOneObject("ADODB.Recordset") 
    Msg = Msg & CheckOneObject("ADODB.Stream") 
    Msg = Msg & CheckOneObject("InternetExplorer.Application") 
    CheckRequirements = Msg 
' MsgBox Msg 
End Function 

'Checks If the one object is installed. 
Function CheckOneObject(oClass) 
    Dim Msg 
    On Error Resume Next 
    CreateObject oClass 
    If Err = 0 Then Msg = "OK" Else Msg = "Error:" & Err.Description 
    CheckOneObject = oClass & " - " & Msg & vbCrLf 
End Function 

は、HTMLのセグメントです。

<input name="userfile" id="userfile" type="file">

+0

第一に、あなたはURL' 'に移動しているが、しかしコードがなければなりませんので、' DestURL'を宣言: 'WebBrowser.Navigate DestURL'。第2に、HTMLソースを見てください。そのURLのファイル選択ボックスはiframe内にあるので、入力は実際には 'fileUpload'と呼ばれ、free-online-ocr.com/upload.aspxにあります。そのページ上の他のコントロールはプログラムによって作成され、隠されます(例えば '__EVENTVALIDATION')。無料サービスのスクリプト化された自動化を防ぐためにのみ存在します。ボタンが押されたかのようにファイルを送信するのではなく、ファイル選択プロセスを自動化することができます。 – Tim

+0

私はこれをもう一度見て、別の問題があります。あなたの説明のリンク(OCRサイト)はnewocr.comですが、あなたのコードのリンクはfree-online-ocr.comです。そのため、実際にどちらのサイトと対話しようとしているのかが不明確になり、実際にどのサイトを自動化するかによってコードは大きく異なります。これは検索エンジンランキングのリンク構築スキームなのでしょうか、投稿を整理する必要がありますか? – Tim

+0

そのnewocr.com、私はそれに気付き、私が投稿する前にコードをそれに応じて再構成しました。申し訳ありませんが、ここで間違ったOCRサイトを使用しました。 – Adhil

答えて

1

あなたはASPにアップロードされたファイルを受け入れるためにScriptUtils.ASPFormを使用することができます。 ScriptUtils.ASPFormには、最高2GBのデータを受け入れることができる高性能、低リソース消費アルゴリズムが含まれています。

    httpとmultipart/form-dataドキュメントを使用してファイルをアップロードするいくつかの手順があります。まず、ディスクからファイルを読み込む必要があります。 Scripting.FileSystemObjectを使用してテキストデータを読み取るか、ADODB.Streamを使用してファイルを読み取ることができます。 GetFile関数は、ADODB.Streamを使用して作業を行います。

  1. 完了する必要があるもう1つのタスクは、マルチパート/フォームデータドキュメントのビルドです。文書には、境界で区切られた複数のフィールドが含まれています。各フィールドには独自のヘッダーがあり、ソースファイルのフィールド名、ファイル名、およびコンテンツタイプに関する情報が含まれています。 ADO Recordsetオブジェクトには、AppartChunkという素晴らしいメソッドがあります。これにより、マルチパート/フォームデータドキュメントの一部(境界線+ヘッダ+ファイルの境界+境界線)を結合できます。 BuildFormData関数でコードを見ることができます。

  2. 最後のタスクは、multipart/form-data Content-Typeヘッダを持つサーバにポストリクエストとしてmultipart/form-dataドキュメントを送信します。 POSTリクエスト(XMLHttpまたはInternetExplorer)を送信するために少なくとも2つのオブジェクトを使用できます。このスクリプトは、InternetExplorer.ApplicationオブジェクトのNavigateメソッドを使用します。 IEPostBinaryRequest関数でコードを見ることができます

詳細については、以下のリンクを参照してください。

http://www.motobit.com/tips/detpg_uploadvbsie/

GETFILE方法は、UTF-8にファイルを変換しています。あなたは

'Converts OLE string To multibyte stringFunction StringToMB(S) 
    Dim I, B 
    For I = 1 To Len(S) 
    B = B & ChrB(Asc(Mid(S, I, 1))) 
    Next 
    StringToMB = B End Function 

私は同じテクニックを試して数日費やしてきた

http://www.mrexcel.com/forum/excel-questions/861695-using-xmlhttp-upload-file-api.html#post4192153

+1

本当にありがとうございます、これについて少し詳しく説明できますか? – Adhil

+0

どうもありがとうございます。しかし、どうすればよいですか?ウェブブラウザにマルチバイトデータをどのように送ることができますか? – Adhil

+0

私が提供しているリンクには詳細な解決策が含まれています。 – newjenn

0

このページを参照してくださいマルチバイト文字列に変換する必要があり PDFファイルは、128以上のバイトを持っています - InternetExplorer.Application COMインターフェイスのNavigateメソッドを使用してファイルをアップロードする。
Navigateのドキュメントでは、postdataパラメータを指定するとHTTP POSTがトリガされることが示されていますが、私の経験ではContent-Typeも決定要因です。 Fiddlerを使う私は、Content-Type = multipart/form-dataのときに、POSTではなくGET HTTPメソッドを一貫して送信していることが分かりました。

GET動詞を送信すると、フォームデータを無視してURIのみを処理するようにサーバーに指示します。

This pageは、HTTPリクエストをより細かく制御できるXMLHTTPオブジェクトで成功したことを示しています。ここでは、この技術を実証し、いくつかのPowerShellのコードです:

$http = (New-Object -ComObject "MSXML2.XMLHTTP") 
$http.Open("POST",$DestURL,$false) 
$http.SetRequestHeader("Content-Type", "multipart/form-data; boundary=" + $boundary) 
$http.Send($PostData) 
関連する問題