.pdf ファイルがロードされたときに readystate をトリガーする簡単な方法を誰かが知っているかどうか疑問に思っていました。URLを開いてスクリーンショットを撮り、それらをExcelに入れるプログラムを構築しています。
Web ブラウザは html ドキュメントを正しくロードしますが、ファイルWhile Not pageready
をロードするときに動かなくなり.pdf
ます。ブラウザ コントロールは、.pdf
.
Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
Dim file As String
Dim Obj As New Object
Dim result As String
Dim sheet As String = "sheet1"
Dim xlApp As New Excel.Application
If lblpath.Text <> "" Then
file = lblpath.Text
Dim xlWorkBook = xlApp.Workbooks.Open(file)
Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
Dim range = xlWorkSheet.UsedRange
ProgressBar1.Value = 0
For rCnt = 4 To range.Rows.Count
'url cell
Obj = CType(range.Cells(rCnt, 2), Excel.Range)
' Obj.value now contains the value in the cell..
Try
' Creates an HttpWebRequest with the specified URL.
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
' Sends the request and waits for a response.
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
result = myHttpWebResponse.StatusCode
WebBrowser1.ScrollBarsEnabled = False
WebBrowser1.Navigate(myHttpWebRequest.RequestUri)
WaitForPageLoad()
CaptureWebBrowser(WebBrowser1)
End If
' Release the resources of the response.
myHttpWebResponse.Close()
Catch ex As WebException
result = (ex.Message)
Catch ex As Exception
result = (ex.Message)
End Try
RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)
If radpre.Checked = True Then
range.Cells(rCnt, 3).value = result
ElseIf radcob.Checked = True Then
range.Cells(rCnt, 4).value = result
ElseIf radpost.Checked = True Then
range.Cells(rCnt, 5).value = result
End If
ProgressBar1.Value = rCnt / range.Rows.Count * 100
Next
With xlApp
.DisplayAlerts = False
xlWorkBook.SaveAs(lblpath.Text.ToString)
.DisplayAlerts = True
End With
xlWorkBook.Close()
xlApp.Quit()
'reclaim memory
Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
End If
End Sub
Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image
Try
Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
wb.DrawToBitmap(hBitmap, wb.Bounds)
Dim img As Image = hBitmap
Return img
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Return Nothing
End Function
Private Sub WaitForPageLoad()
AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
While Not pageready
Application.DoEvents()
End While
pageready = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
pageready = True
RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End If
End Sub
解決済みに更新
フィードバックにとても満足しています。Noseratioが提供した答えが本当に気に入っています。ベスト プラクティスではないので、コード パターンを使用していることに気づきませんでした。readyState
.pdf または Web ベースではないその他のドキュメントを開くと、0
. このプログラムが、単に私が仕事をしないための方法であることを見て、私は と をキャプチャするだけで満足してい.html
ます.htm
。
私の要件は
- エクセル文書を開く
- Excel ドキュメントにあるリンクを解析する
- 応答コードを決定する
- 応答コードを書き、可能であればスクリーンショットを Excel に
このプログラムは、手動で行うよりもはるかに高速にフィードバックを解析して取得します。技術に詳しくない人向けに、本番環境から COB への移行、および本番環境への移行が成功したことを証明する Excel ファイルのスクリーンショットを.html
提供します。.htm
Noseratioが述べたこのコードは、ベスト プラクティスに従っておらず、高品質でもありません。これは簡単で汚い実装です。
Option Infer On
Imports Microsoft.Office.Interop
Imports System.Net
Imports System.Runtime.InteropServices
Public Class Form1
Public Property pageready As Boolean
Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
OpenFileDialog1.ShowDialog()
End Sub
Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
lblpath.Text = OpenFileDialog1.FileName.ToString
End Sub
Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
Dim file As String
Dim Obj As New Object
Dim result As String
Dim sheet As String = "sheet1"
Dim xlApp As New Excel.Application
Dim img As Bitmap
Dim path As String = "C:\Documents and Settings\user\My Documents\Visual Studio 2010\Projects\COB-HTML-Tool\COB-HTML-Tool\bin\Debug\tmp.bmp"
If lblpath.Text <> "" Then
file = lblpath.Text
Dim xlWorkBook = xlApp.Workbooks.Open(file)
Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
Dim range = xlWorkSheet.UsedRange
ProgressBar1.Value = 0
For rCnt = 4 To range.Rows.Count
'url cell
Obj = CType(range.Cells(rCnt, 2), Excel.Range)
' Obj.value now contains the value in the cell..
Try
' Creates an HttpWebRequest with the specified URL.
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
' Sends the request and waits for a response.
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
result = myHttpWebResponse.StatusCode
Dim len As Integer = myHttpWebRequest.RequestUri.ToString.Length - 4
If myHttpWebRequest.RequestUri.ToString.Substring(len) = ".htm" Or
myHttpWebRequest.RequestUri.ToString.Substring(len - 1) = ".html" Or
myHttpWebRequest.RequestUri.ToString.Substring(len) = ".asp" Then
WebBrowser1.Navigate(myHttpWebRequest.RequestUri)
WaitForPageLoad()
img = CaptureWebBrowser(WebBrowser1)
img.Save(path)
End If
End If
' Release the resources of the response.
myHttpWebResponse.Close()
Catch ex As WebException
result = (ex.Message)
Catch ex As Exception
result = (ex.Message)
End Try
RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)
If radpre.Checked = True Then
range.Cells(rCnt, 3).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 4).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
ElseIf radcob.Checked = True Then
range.Cells(rCnt, 5).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 6).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
ElseIf radpost.Checked = True Then
range.Cells(rCnt, 7).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 8).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
End If
ProgressBar1.Value = rCnt / range.Rows.Count * 100
Next
With xlApp
.DisplayAlerts = False
xlWorkBook.SaveAs(lblpath.Text.ToString)
.DisplayAlerts = True
End With
xlWorkBook.Close()
xlApp.Quit()
'reclaim memory
Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
End If
End Sub
Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image
Try
wb.ScrollBarsEnabled = False
Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
wb.DrawToBitmap(hBitmap, wb.Bounds)
Dim img As Image = hBitmap
Return img
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Return Nothing
End Function
Private Sub WaitForPageLoad()
AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
While Not pageready
Application.DoEvents()
System.Threading.Thread.Sleep(200)
End While
pageready = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
pageready = True
RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End If
End Sub
End Class