Ú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: 147
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: 226
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: 147
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: 226
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: 147
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
    709
    od Grimm
    15 čer 2019 16:28
  • Stažení obrázku ve velkém rozlišení z kódu webu
    od Grander » 04 úno 2020 22:09 » v Internet a internetové prohlížeče
    4
    266
    od Grander
    05 úno 2020 00:50
  • Úprava R5 3600
    od casperdeluxe » 16 úno 2020 22:13 » v Taktování a další úpravy PC
    40
    1375
    od casperdeluxe
    18 úno 2020 15:06
  • úprava fotek
    od imfine » 26 říj 2019 22:23 » v Vše ostatní (sw)
    5
    819
    od xbs
    27 říj 2019 15:18
  • úprava barvy
    od ibro79 » 20 črc 2019 22:27 » v Problémy s hardwarem
    6
    571
    od ibro79
    21 črc 2019 14:59

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

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 3 hosti