Kako kopirati ali premakniti datoteke iz ene mape v drugo na podlagi seznama v Excelu? 

Če imate seznam imen datotek v stolpcu na delovnem listu in datoteke poiščete v mapi v računalniku. Zdaj pa morate te datoteke, katerih imena so navedena na delovnem listu, iz prvotne mape premakniti ali kopirati v drugo, kot je prikazano na spodnji sliki zaslona. Kako lahko to nalogo končate čim hitreje v Excelu?

Kopirajte ali premaknite datoteke iz ene mape v drugo na podlagi seznama v Excelu s kodo VBA

Kopirajte ali premaknite datoteke iz ene mape v drugo na podlagi seznama v Excelu s kodo VBA

Če želite datoteke premakniti iz ene mape v drugo na podlagi seznama imen datotek, vam bo morda v korist naslednja koda VBA, storite tako:

1. Držite tipko Alt + F11 tipke v Excelu in odpre Microsoft Visual Basic za aplikacije okno.

2. Kliknite Vstavi > Moduliin v okno modula prilepite naslednjo kodo VBA.

Koda VBA: premaknite datoteke iz ene mape v drugo na podlagi seznama v Excelu

Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = " Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub

3. In nato pritisnite F5 tipko za zagon te kode in pojavilo se bo pozivno polje, ki vas bo opozorilo na izbiro celic, ki vsebujejo imena datotek, glejte posnetek zaslona:

4. Nato kliknite OK in v pojavnem oknu izberite mapo, ki vsebuje datoteke, iz katerih se želite premakniti, glejte posnetek zaslona:

5. In nato kliknite OK, nadaljujte z izbiro ciljne mape, kamor želite poiskati datoteke, v drugem izpuščnem oknu, glejte posnetek zaslona:

6. Nazadnje kliknite OK da zaprete okno, in zdaj so bile datoteke premaknjene v drugo mapo, ki ste jo določili na podlagi imen datotek na seznamu delovnih listov, glejte posnetek zaslona:

Opombe: Če želite datoteke samo kopirati v drugo mapo, vendar ohranite izvirne datoteke, uporabite spodnjo kodo VBA:

Koda VBA: Kopirajte datoteke iz ene mape v drugo na podlagi seznama v Excelu

Sub copyfiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub