Excelマクロネットワークドライブから他のフォルダにイメージをコピーする

Question

私はVBAコーディングには非常に慣れていて、ネットワークドライブから複数のイメージをダウンロード/コピーするマクロを持っている友人を助けようとしています。それらをデスクトップ上のフォルダに保存します。

スプレッドシート内のデータがそのまま設定されます。 マクロは、列Bに記載されているパスから画像をコピーして、列Aからのデータを用いて画像の名前を変更して、デスクトップ上のフォルダに保存します

column A -   column B  -    column C 

3487458 - N:/path1/image1.jpg - http://www.website.com/data.pdf 

5412132 - N:/path2/image2.jpg - http://www.website.com/data2.pdf 

私は列のデータのために働くことにこれを持っていますCのhtmlリンクですが、ネットワークドライブへのパスであるB列のデータを処理する必要があります。

Const TargetFolder = "C:\Users\XXXX\Desktop\Output\" 
Private Declare PtrSafe 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 


Sub Test() 
    For Each Hyperlink In ActiveSheet.Hyperlinks 
     LocalFileName = ActiveSheet.Cells(Hyperlink.Range.Row, 1).Value & 
".pdf" 
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName) 
    Next Hyperlink 
End Sub 

おかげで、ロイ

EDIT：上に行くために

Sub copythem() 
Dim rw As Long, start_row As Long, end_row As Long 
Dim destination_folder As String 
Dim suffix As String 

suffix = ".jpg" 

With ActiveSheet 
    start_row = 1 
    end_row = .Cells(.Rows.Count, "B").End(xlUp).Row 

    destination_folder = "C:\Users\XXXX\Desktop\Output\" ' Set destination as user's desktop 

    For rw = start_row To end_row 
     If Dir(.Cells(rw, 2)) <> "(.Cells(rw, 2))" Then 
      FileCopy .Cells(rw, 2), destination_folder & .Cells(rw, 1) & suffix 
     Else 
      MsgBox "File: " & .Cells(rw, 2) & " is not found." 
     End If 
    Next 

End With 
End Sub 

Answer 1

ないたくさん働いCODEが、ファイルタイプ（suffix）と同様に、途中でいくつかの仮定を作りますあなたは「デスクトップ」と言っています - 最近のWindows版のデスクトップを意味します。

Sub copythem() 
    Dim rw As Long, start_row As Long, end_row As Long 
    Dim destination_folder As String 
    Dim suffix As String 

    suffix = ".jpg" 

    With ActiveSheet 
     start_row = 1 
     end_row = .Cells(.Rows.Count, "B").End(xlUp).Row 

     destination_folder = Environ("homedrive") & Environ("homepath") & "\desktop\output\" ' Set destination as output folder in user's desktop 

     For rw = start_row To end_row 
      If Dir(.Cells(rw, 2)) <> "" Then 
       FileCopy .Cells(rw, 2), destination_folder & .Cells(rw, 1) & suffix 
      Else 
       MsgBox "File: " & .Cells(rw, 2) & " is not found." 
      End If 
     Next 

    End With 
End Sub