přestala fungovat funkce přesunutí souborů a složek

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

Moderátor: Mods_senior

crgo77
Level 1
Level 1
Příspěvky: 68
Registrován: duben 14
Pohlaví: Muž
Stav:
Offline

přestala fungovat funkce přesunutí souborů a složek

Příspěvekod crgo77 » 02 zář 2015 20:25

Zdravím všechny,
prosím o pomoc.
Níže vkládám kód,který používám ve sdílené aplikaci pro přesouvání souborů a složek do jiné složky.
Názvy složek jsou zde proměnné.Kód je součástí rozsáhlého kódu(userformu) proto jsem vložil jenom tlačítko,které funkci spustí.
Jde o to,že když se mi to podařilo zprovoznit-vždy mi fungovalo jen přesunutí složek nebo jen přesunutí souborů-pak mi vše chodilo jak má-přesouvaly se jak složky tak soubory.Jenže mi asi po nějaké době nastal problém v tom,že se mi někdy přesunou složky a soubory zůstanou nebo obráceně.
Překontrolovával jsem kód několikrát ( bohužel jsem si to vůbec nepopsal),nějakou dobu si kódy ukládám do textových souborů s názvy funkcí(co mají dělat) a nenašel jsem žádný rozdíl a navíc nejsem schopný ani zjistit proč mi to takhle blbne.
Proto prosím o pomoc zde přítomné,možná jiní uvidí chybu kterou já nevidím.
Předem děkuji za pomoc.

Zde kód tlačítka:

[
Private Sub CommandButton15_Click()
Dim fso As Object
Dim FromPath As String
Dim ToPath As String
Dim FolderExt As String
Dim FNames As String
Dim FileInFromFolder As Object

FromPath = "Z:\PLC\" & Label27.Caption & "\" & TextBox11.Text & "\"
ToPath = "Z:\OLD-PLC\" & Label27.Caption & "\" & TextBox12.Text & "\"

FileExt = "*.*"

If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If

FNames = Dir(FromPath & FileExt)
If Len(FNames) = 0 Then
MsgBox "soubory v " & FromPath & "neexistují"
Exit Sub
End If

Set fso = CreateObject("scripting.filesystemobject")

fso.CreateFolder (ToPath)

For Each FileInFromFolder In fso.getfolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)

FileInFromFolder.Move ToPath

Next FileInFromFolder

fso.MoveFolder Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "Všechny složky a soubory přesunuty z " & FromPath & " do " & ToPath

mytxt = Label30.Caption & " " & TextBox13 'bez ohledu na textové pole text je v
Open ToPath & "\důvod úpravy PLC.txt" For Append As #1 ' změňte cestu, aby odrážel cestu

Print #1, mytxt
Close #1

fso.CopyFile ToPath & "\důvod úpravy PLC.txt", FromPath & "\důvod úpravy PLC.txt"
End Sub
]

Reklama
  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Velikost souboru a složek na disku
    od L.L » 05 úno 2025 11:50 » v Vše ostatní (sw)
    5
    3268
    od L.L Zobrazit poslední příspěvek
    05 úno 2025 17:42
  • Upgrade PC - bude to fungovat?
    od pd321 » 12 pro 2024 13:09 » v Rady s výběrem hw a sestavením PC
    6
    1854
    od petr22 Zobrazit poslední příspěvek
    15 pro 2024 17:59
  • Adobe reader přestal fungovat
    od pee.tr » 03 říj 2024 18:41 » v Vše ostatní (sw)
    3
    2370
    od pee.tr Zobrazit poslední příspěvek
    03 říj 2024 20:14
  • Na MS Outlook 2019 přestaly fungovat gmail účty Příloha(y)
    od tazatel » 12 kvě 2025 13:02 » v Komunikace na internetu
    17
    7742
    od rhsCZ Zobrazit poslední příspěvek
    14 kvě 2025 18:57
  • Blokování stahovaných souborů
    od Riviera kid » 07 čer 2025 16:47 » v Windows 11, 10, 8...
    10
    2990
    od Riviera kid Zobrazit poslední příspěvek
    včera, 06:56

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti