1

Excel 2010 を使用して VBA で簡単なサブルーチンを作成して、bit.ly を使用して URL のリストを自動化し、短縮されたリンクをコピーして元のリンクを置き換えようとしています。しかし、途中でエラー 70: Permission Denied ランタイム エラーが発生します。私はいくつかのコースを受講しましたが、これはほとんど機能しますが、VBA にはあまり詳しくないので、可能であればこれをデバッグする際に何らかの助けを借りることができます (非常に役立ちます)。コードは次のとおりです。

Option Explicit

Dim IE As Object

Sub AutoAbbrev()

Set IE = CreateObject("InternetExplorer.Application")
Dim holdURL As String
Dim row_number As Integer
IE.Visible = True

For row_number = 101 To 112

holdURL = ""

If Range("b" & row_number).Value = "" Then GoTo Skip

IE.navigate "http://www.bitly.com" 'load bit.ly

Do While IE.readyState <> 4
    DoEvents
Loop

IE.document.all("shorten_url").Value = Range("b" & row_number).Value
IE.document.all("shorten_btn").Click

Do While IE.document.all("shorten_url").Value = Range("b" & row_number).Value Or IE.document.all("shorten_url").Value = ""
    DoEvents
Loop

holdURL = IE.document.all("shorten_url").Value
IE.document.all("shorten_url").Value = ""
Range("b" & row_number).Value = holdURL

Skip:
Next row_number

End Sub

Private Sub Command1_Click()

AutoAbbrev
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set IE = Nothing
If TypeName(IE) <> "Nothing" Then Unload IE
Set IE2 = Nothing
If TypeName(IE2) <> "Nothing" Then Unload IE2

End Sub

プログラムが 1 回以上の反復を実行した後、エラーは主にこの行でスローされます。

Do While IE.document.all("shorten_url").Value = Range("b" & row_number).Value Or IE.document.all("shorten_url").Value = ""
        DoEvents
    Loop

このこぶを乗り越えるのに役立つ具体的なアドバイスがあれば、大いに感謝します。ありがとう！

4

2 に答える 2

1

Internet Explorer の自動化は常に最後の手段である必要があります。これは遅く、変更されていないページの構造に依存しています。利用可能な場合は常に API を選択することをお勧めします。この場合は、リンクをショットするための API をビット単位で提供します。認証トークンを取得して、以下に入力するだけです。

Public Function Shorten(url As String) As String

    Const token As String = "YOUR AUTHENTICATION TOKEN"
    Static oRequest As Object

    If oRequest Is Nothing Then Set oRequest = CreateObject("winhttp.winhttprequest.5.1")

    With oRequest
        .Open "GET", "https://api-ssl.bitly.com/v3/shorten?access_token=" & token & "&longUrl=" & url & "&format=xml", False
        .send
        If Left(Split(.responsetext, "txt>")(1), 2) = "OK" Then Shorten = Split(Split(.responsetext, "url>")(1), "<")(0)
    End With

End Function

その後、上記をワークシートの関数として使用できます

于 2013-09-25T09:54:33.463 に答える
0

これは、ページが完全に読み込まれていないために発生することがわかりました。IE は遅いですが、object.click イベントで開く必要がある Div に動的コンテンツがあるため、IE を使用する必要がある場合があります。Do until Not appIE.Busy And appIE.ReadyState = 4: DoEvents: ループは役に立ちますが、ブラウザがハングアップする可能性もあるため、タイマーを使用して待機期間を追加すると役立ちます。

于 2020-07-30T03:06:21.093 に答える