簡體   English   中英

Excel VBA錯誤類型'13'類型不匹配

[英]Excel VBA error type '13' typemismatch

Option Explicit

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr _
      ) As Long
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long _
      ) As Long
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#End If

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000

    'Global Variables for passing values b/w subs
    Dim myPath As String
    Dim folderPath As String
    Dim folderLocation As Variant





Sub airtableCleaner()
    Dim argCounter As Integer
    Dim Answer As VbMsgBoxResult

    Dim strProgramName As String
    Dim strArgument As String
    Dim shellCommand As String

    folderPath = Application.ActiveWorkbook.Path 'Example C:/downloads
    myPath = Application.ActiveWorkbook.FullName 'Example C:/downloads/book1.csv

    'Ask user if they want to run macro
    Answer = MsgBox("Run? Airtable - 1: primaryKey, 2: one image attachment", vbYesNo, "Run Macro")
    If Answer = vbYes Then

    folderLocation = Application.InputBox("Give a subfolder name for directory. E.G. Batch1")

    'Creates new folder based on input
    Dim strDir As String
    strDir = folderPath & "\" & folderLocation

    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        MsgBox "Directory exists."
    End If

    'Cleanup to just amazons3 dl.airtable links
    Columns("B:B").Select
    Selection.Replace What:="* ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    'Count Cells
    Range("B2").Activate
    Do
        If ActiveCell.Value = "" Then Exit Do
        ActiveCell.Offset(1, 0).Activate
        argCounter = argCounter + 1

    Loop

    'Copy Image Links to new cells to format in Column C
    Columns("B:B").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'Clean up links to only have names in Column C
    Selection.Replace What:="https://dl.airtable.com/", Replacement:="", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
    False, ReplaceFormat:=False


    'Cleanup Broken images using excelVBA downloader %5B1%5D = B1D
     Columns("C:C").Select
     Range("C40").Activate
     Selection.Replace What:="%5B1%5D", Replacement:="B1D", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False


    'Create Column D batch files           
        Range("D2").Formula = "=CONCATENATE(""COPY "",CHAR(34), " & folderPath & "\" & ", C2,CHAR(34),"" "", CHAR(34), " & _
                      Chr(34) & folderPath & "\" & folderLocation & "\" & Chr(34) & ",A2,"".png"",CHAR(34))"                              

    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & argCounter + 1)

    'Delete header row 1 information
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

    'Repaste values back into column D removing formulas
        Columns("D:D").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'Image downloader to source folder
    Call dlStaplesImages

    'Make the batch files using row data col D
    Call ExportRangetoBatch

    'Ask user to run bat file now or later
    shellCommand = """" & folderPath & "\" & "newcurl.bat" & """"
    Call Shell(shellCommand, vbNormalFocus)

    End If
End Sub

'https://superuser.com/questions/1045707/create-bat-file-with-excel-data-with-vba    , modified copypasta code

Sub ExportRangetoBatch()

    Dim ColumnNum: ColumnNum = 4   ' Column D
    Dim RowNum: RowNum = 1          ' Row to start on
    Dim objFSO, objFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(folderPath & "\newcurl.bat")    'Output Path

    Dim OutputString: OutputString = ""

    OutputString = "Timeout 3" & vbNewLine 'useful for error checking

    Do
        OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine 'Goes to new line in string, then creates another
        RowNum = RowNum + 1
    Loop Until IsEmpty(Cells(RowNum, ColumnNum))

    OutputString = OutputString & "Timeout 3"   'useful for errorchecking


    objFile.Write (OutputString)

    Set objFile = Nothing
    Set objFSO = Nothing

End Sub



'https://stackoverflow.com/questions/31359682/with-excel-vba-save-web-image-to-disk/31360105#31360105      , modified copypasta code

Sub dlStaplesImages()
    Dim rw As Long, lr As Long, ret As Long, sIMGDIR As String, sWAN As String, sLAN As String

    sIMGDIR = folderPath
    'If Dir(sIMGDIR, vbDirectory) = "" Then MkDir sIMGDIR

    With ActiveSheet    '<-set this worksheet reference properly!
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        For rw = 1 To lr 'rw to last row, assume first row is not header

            sWAN = .Cells(rw, 2).Value2
            sLAN = sIMGDIR & Chr(92) & Trim(Right(Replace(sWAN, Chr(47), Space(999)), 999))

            Debug.Print sWAN
            Debug.Print sLAN

            If CBool(Len(Dir(sLAN))) Then
                Call DeleteUrlCacheEntry(sLAN)
                Kill sLAN
            End If

            ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&)

            'Imported code to output success / fail
            If ret = 0 Then
            Range("E" & rw).Value = "File successfully downloaded"
        Else
            Range("E" & rw).Value = "Unable to download the file"
        End If

            '.Cells(rw, 5) = ret
            Next rw
    End With

End Sub

我有這組代碼。 上面的代碼可以正常工作。 基本上,它需要一些輸入數據,轉換數據,下載圖像並輸入.batch文件以重命名許多所有圖像。

我遇到的問題是更改此行時:

Range("D2").Formula = "=CONCATENATE(""COPY "",CHAR(34),C2,CHAR(34),"" "", CHAR(34), " & _
                          Chr(34) & folderPath & "\" & folderLocation & "\" & Chr(34) & ",A2,"".png"",CHAR(34))"

到此新行:

Range("D2").Formula = "=CONCATENATE(""COPY "",CHAR(34), " & folderPath & "\" & ", C2,CHAR(34),"" "", CHAR(34), " & _
                          Chr(34) & folderPath & "\" & folderLocation & "\" & Chr(34) & ",A2,"".png"",CHAR(34))"  

我在這里出錯

運行時錯誤'13':類型不匹配

在這行我做一個do循環

OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine 'Goes to new line in string, then creates another

最初, OutputString采用如下迭代值:

COPY "foo.png" "C:\\batch\\foo2.png"

現在,我正在嘗試為此:

COPY "C:\\foo.png" "C:\\batch\\foo2.png"

我唯一更改的是添加了一個更長的字符串值,該值必須要讀取outputString 我不確定為什么會出現13型錯誤(變量數據類型不匹配)

將變量傳遞到VBA中的excel函數時,Excel的語法確實令人困惑。

發生了什么事,我是原本直接在excel公式中傳遞了folderPath變量(例如C:\\ foo),當時我本應分別連接每個結果(這在我以前的解決方案中是不可能的)

所以我只使用了沒有內置的excel函數重寫了一組干凈的代碼

導致錯誤類型13代碼語句的原始代碼段:

Range("D2").Formula = "=CONCATENATE(""COPY "",CHAR(34), " & folderPath & "\" & ", C2,CHAR(34),"" "", CHAR(34), " & _
                          Chr(34) & folderPath & "\" & folderLocation & "\" & Chr(34) & ",A2,"".png"",CHAR(34))"

新的簡潔易讀/編輯代碼:

For row = 2 To argCounter + 1
    A = Cells(row, 1).Value
    C = Cells(row, 3).Value

    A = """" & folderPath & "\" & folderLocation & "\" & A & ".png" & """"
    C = """" & folderPath & "\" & C & """"

    Cells(row, 4).Value = "Copy " & C & " " & A
Next row

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM