0

在下面的代码中，我试图将值放在弹出的单元格 A1（这是上传窗口中的地址）中；有没有办法将值放在 sheet1 中的单元格 A1 中（在文件名文本框中），然后按确定，通过在 VBA 中模拟它，我想到了 sendkeys 但它不起作用

这是我当前的代码：我引用了 2 个库：Microsoft HTML Object Library Microsoft Internet Controls

    Sub GetBase64()

Dim ie As New InternetExplorer
Dim doc As HTMLDocument
ie.Visible = True
ie.navigate ("http://webcodertools.com/imagetobase64converter/Create")
Do While ie.Busy
  Application.Wait DateAdd("s", 1, Now)
Loop

Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document

doc.getElementById("file").Click

End Sub

谢谢你的帮助

4

1 回答 1

2

我对您的代码进行了一些修改，并结合了此处描述的解决方案。

在我有限的过去经验中，抓住那些“打开”对话框的句柄是很棘手的和/或不可能的，而且SendKeys是出了名的不可靠。

我已经对此进行了测试，该GetBase64函数现在分配了另外两个变量imgTag，css您可能需要它们，它们是上传的“结果”。

Public ie As InternetExplorer
Sub GetBase64()
Dim doc As HTMLDocument
Const URL As String = "http://webcodertools.com/imagetobase64converter/Create"
Dim sFile As String
Dim e As Variant
Dim imgTag As String
Dim css As String

sFile = Range("A1").Value
Set ie = CreateObject("InternetExplorer.Application")

With ie
    .Visible = True
    .navigate URL
    Do
        DoEvents
    Loop Until .readyState = 4

    UploadFile URL, sFile, "file"

    'Now, get the strings from the IE window
    Set doc = .document

    For Each e In doc.getElementsByTagName("textarea")
    '## This is not the most sophisticated way of doing this, but it works:
        If Left(e.innerText, 1) = "<" Then
            imgTag = e.innerText
        Else:
            css = e.innerText
        End If
    Next

End With


End Sub


Sub UploadFile(DestURL As String, FileName As String, _
  Optional ByVal FieldName As String = "File")
  Dim sFormData As String, d As String

  'Boundary of fields.
  'Be sure this string is Not In the source file
  Const Boundary As String = "---------------------------0123456789012"

  'Get source file As a string.
  sFormData = GetFile(FileName)

  'Build source form with file contents
  d = "--" + Boundary + vbCrLf
  d = d + "Content-Disposition: form-data; name=""" + FieldName + """;"
  d = d + " filename=""" + FileName + """" + vbCrLf
  d = d + "Content-Type: application/upload" + vbCrLf + vbCrLf
  d = d + sFormData
  d = d + vbCrLf + "--" + Boundary + "--" + vbCrLf

  'Post the data To the destination URL
  IEPostStringRequest DestURL, d, Boundary
End Sub

'sends URL encoded form data To the URL using IE
Sub IEPostStringRequest(URL As String, FormData As String, Boundary As String)

Dim WebBrowser As Object
Set WebBrowser = ie
  'Send the form data To URL As POST request
  Dim bFormData() As Byte
  ReDim bFormData(Len(FormData) - 1)
  bFormData = StrConv(FormData, vbFromUnicode)

  WebBrowser.navigate URL, , , bFormData, _
    "Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf

  Do While WebBrowser.Busy
'    Sleep 100
    DoEvents
  Loop
'Leave the browser open
'  WebBrowser.Quit
End Sub

'read binary file As a string value
Function GetFile(FileName As String) As String
  Dim FileContents() As Byte, FileNumber As Integer
  ReDim FileContents(FileLen(FileName) - 1)
  FileNumber = FreeFile
  Open FileName For Binary As FileNumber
    Get FileNumber, , FileContents
  Close FileNumber
  GetFile = StrConv(FileContents, vbUnicode)
End Function
'******************* upload - end

更新这里是在我的电脑上成功使用的截图，注意我在测试时使用了后期绑定（ie as Object, doc As Object）以避免需要参考；但只要您启用了这些引用，您就应该能够将Dim它们作为特定的对象类型。

在此处输入图像描述

于 2013-08-15T14:30:11.387 回答