2017-06-06 69 views
0
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文件後Excel VBA錯誤類型'13'typemismatch

我是當我改變這一行的問題很多的所有圖像重命名:

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類型的錯誤(變量數據類型不匹配)傳遞變量到Excel的功能VBA時

+1

當發生錯誤時,Cells(RowNum,ColumnNum).Value究竟是什麼? – jkpieterse

+1

構建公式時,你千萬不要把引號'folderPath',讓您得到得到的公式在不帶引號的路徑從而導致了'#NAME?'錯誤中給出的類型不匹配的電池,當您嘗試通過錯誤值替換爲'Replace'。請調試您的代碼。這是不難觀察'#NAME?'在細胞或在工具提示過'細胞(ROWNUM,COLUMNNUM).Value'。 – GSerg

+0

如果您嘗試合併字符串和錯誤,則會引發類型不匹配。是否有任何理由不使用更強類型的變量?我猜想你的'Replace'調用可能會引發錯誤。嘗試隔離該聲明在* *即時窗格或做'MsgBox'進行查看,並查看是否有錯誤就該報表單獨提出。 –

回答

0

Excel的語法讓人有些困惑。

發生了什麼事是我逐字傳遞的FOLDERPATH變量(例如C:\富)直接在Excel公式的時候我應該已經seperately拼接每個結果(這是不可能與我以前的解決方案)

所以我就改寫了用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