Úprava kódu Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

luko02420
Level 1.5
Level 1.5
Příspěvky: 141
Registrován: únor 12
Pohlaví: Nespecifikováno

Úprava kódu

Příspěvekod luko02420 » 04 dub 2019 11:33

Dobrý den, potřebuji poradit jak upravit následující kód na kopirování aby me to automaticky ukladalo do určených složek.
Ted to musim delat rucne, coz neni ono.
Dekuji vsem za pomoc.

Kód: Vybrat vše

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 = ActiveSheet.Range("A2:A5")  'Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 1)
    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



Reklama
Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 212
Registrován: červen 13
Pohlaví: Muž

Re: Úprava kódu

Příspěvekod elninoslov » 04 dub 2019 11:50

??? Takže nechcete vyberať v tých dvoch dialógových oknách Source zložku ani Destination zložku ? Tak tie premenné zadefinujte natrvalo a v kóde im priradte cesty.

Kód: Vybrat vše

xSPathStr = "C:\Fero Mrkva\Origo\"
xDPathStr = "C:\Jano Lúčny\Kópie\"

Inak Vám nerozumiem, o čo teda ide. Čo presne znamená "automaticky ukladalo do určených složek". Uveďte konkrétne príklady.

luko02420
Level 1.5
Level 1.5
Příspěvky: 141
Registrován: únor 12
Pohlaví: Nespecifikováno

Re: Úprava kódu

Příspěvekod luko02420 » 04 dub 2019 12:45

Dobrý den, šlo mi přesně o to, jak jste to pochopil. Nechci tam ty dialogove okna. Pokouším se do kodu pridat ty cesty natrvalo ale zatim se mi to nedarí.

Prosim kde přesně nastavit cestu nemuzu to rozchodit. Dekuji

Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 212
Registrován: červen 13
Pohlaví: Muž

Re: Úprava kódu

Příspěvekod elninoslov » 04 dub 2019 14:58

Kód: Vybrat vše

Sub copyfiles()
    Dim xCell As Range
    Dim xVal As String
   
    Const xSPathStr = "z:\Kopírovanie označených súborov\Origo\"
    Const xDPathStr = "z:\Kopírovanie označených súborov\Kópie\"
   
    On Error Resume Next
    For Each xCell In ActiveSheet.Range("A2:A5")
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next xCell
End Sub

luko02420
Level 1.5
Level 1.5
Příspěvky: 141
Registrován: únor 12
Pohlaví: Nespecifikováno

Re: Úprava kódu  Vyřešeno

Příspěvekod luko02420 » 04 dub 2019 15:31

To je presne ono, rikam to porad, ze mate zlaty ruce.
Dekuji


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Úprava kódu
    od barunkabro » 12 čer 2019 09:18 » v Kancelářské balíky
    1
    657
    od Grimm
    15 čer 2019 16:28
  • úprava barvy
    od ibro79 » 20 črc 2019 22:27 » v Problémy s hardwarem
    6
    499
    od ibro79
    21 črc 2019 14:59
  • úprava fotek
    od imfine » 26 říj 2019 22:23 » v Vše ostatní (sw)
    5
    587
    od xbs
    27 říj 2019 15:18
  • Úprava videí
    od HelFix » 16 bře 2019 14:25 » v Poptávka po práci
    9
    2013
    od HelFix
    26 bře 2019 19:06
  • úprava tabulky
    od butes » 15 led 2019 18:31 » v Kancelářské balíky
    5
    800
    od butes
    21 led 2019 09:41

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 10 hostů