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

Odpovědět
crgo77
Level 1
Level 1
Příspěvky: 68
Registrován: 05 dub 2014 22:22

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

Příspěvek od crgo77 »

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
]
Odpovědět
  • Podobná témata
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Velikost souboru a složek na disku
    od L.L » » v Vše ostatní (sw)
    5 Odpovědi
    6497 Zobrazení
    Poslední příspěvek od L.L
  • Upgrade PC - bude to fungovat?
    od pd321 » » v Rady s výběrem hw a sestavením PC
    6 Odpovědi
    5132 Zobrazení
    Poslední příspěvek od petr22
  • Budou tyto CD/DVD mechaniky fungovat?
    od vlazy » » v Vše ostatní (hw)
    20 Odpovědi
    31860 Zobrazení
    Poslední příspěvek od zeus
  • Na MS Outlook 2019 přestaly fungovat gmail účty
    od tazatel » » v Komunikace na internetu
    17 Odpovědi
    19713 Zobrazení
    Poslední příspěvek od rhsCZ
  • Blokování stahovaných souborů
    od Riviera kid » » v Windows 11, 10, 8...
    10 Odpovědi
    7706 Zobrazení
    Poslední příspěvek od Riviera kid

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