2016-02-11 235 views
1

我有很多圖片需要下載到我的文件夾並重命名。我已經嘗試過下面的宏,但它不適用於32位excel請幫助我在64位上工作。將32位轉換爲64位

Option Explicit 

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 

Dim Ret As Long 

'~~> This is where the images will be saved. Change as applicable 
Const FolderName As String = "C:\Temp\" 

Sub Sample() 
    Dim ws As Worksheet 
    Dim LastRow As Long, i As Long 
    Dim strPath As String 

    '~~> Name of the sheet which has the list 
    Set ws = Sheets("Sheet1") 

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row 

    For i = 2 To LastRow '<~~ 2 because row 1 has headers 
     strPath = FolderName & ws.Range("A" & i).Value & ".jpg" 

     Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0) 

     If Ret = 0 Then 
      ws.Range("C" & i).Value = "File successfully downloaded" 
     Else 
      ws.Range("C" & i).Value = "Unable to download the file" 
     End If 
    Next i 
End Sub 
+0

不確定它是否是更大的一部分,但是您可以使用[IRFanview](http://www.irfanview.com/)來批量重命名和調整圖像大小。 – CustomX

回答

5

如果您希望導入的函數可以同時適用於32位和64位,則需要在聲明中使用編譯器指令。

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 
Public Const folderName As String = "c:\temp\" 

Sub downloadImages() 
    Dim i As Long, ret As Long, sWAN As String, sLAN As String 

    With Worksheets("Sheet1") 
     For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 
      sLAN = folderName & .Cells(i, 1).Value & ".jpg" 
      sWAN = .Cells(i, 2).Value 
      ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&) 

      If ret = 0 Then 
       .Cells(i, 3) = "File successfully downloaded" 
      Else 
       .Cells(i, 3) = "Unable to download the file" 
      End If 
     Next i 
    End With 

End Sub 

#If VBA7 And Win64 Then告訴VBA如何編譯導入的函數。 64位版本使用PtrSafe。以上是在32位和64位上進行測試的。

+0

嗨,美好的一天,非常感謝你,我真的很感激它,這是完美的,現在我可以把我的工作變得簡單..工作人員 – ramon

+0

這項工作對我來說,但它掛起很多,我不能在excel上工作,,任何建議請? – ramon

+0

請忽略我以前的評論它現在正在工作我剛剛刪除了32位聲明謝謝你 – ramon