Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64028 Skopiuj do schowka Kod do kopiowania plików pomiędzy folderami
Autor Wiadomość
huraganbzq 
świeżak


Posty: 5
Wysłany: 04-02-2019, 14:36   Kod do kopiowania plików pomiędzy folderami

Witam!!

Mam następujący problem...
Nie mam pomysłu na kod który kopiował by plik z jednego folderu do innego którego adres zmieniał by się w zależności od zawartości konkretnej komórki

Dokładnie to po uruchomieniu makra w pliku chciałbym aby automatycznie skopiowało plik znajdujący się w folderze "SZABLONY" o nazwie "Rejestr zmian" i wkleiło pod tą samą nazwą go do Folderu "RECEPTY" do istniejącego w nim podfolderu ale dokładnie do podfolderu o nazwie zaciągniętej z komórki "AA10"( zmienna )

Foldery SZABLONY i RECEPTY znajdują się w tym samym folderze co plik główny...

Niestety w kodzie muszę użyć " ThisWorkbook.Path " a nie konkretnej ścieżki dostępu ponieważ całość musi działać nawet po przekopiowaniu folderu zawierającego całą strukturę w inna lokalizację na dysku lub komputer

No i niestety wszystkie próby rozwiązania problemu nie dają rezultatów
_________________
Ł.B
ID posta: 361921 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 04-02-2019, 14:56   

Forum wita ...
huraganbzq napisał/a:
dokładnie do podfolderu o nazwie zaciągniętej z komórki "AA10"( zmienna )

Z 'AA10', ale z którego pliku ? Z pliku zawierającego makro ? Z pliku "Rejestr zmian.xlsx" ? Z jakiegoś jeszcze innego ? I co oznacza "zmienna" ?
ID posta: 361923 Skopiuj do schowka
 
 
huraganbzq 
świeżak


Posty: 5
Wysłany: 04-02-2019, 15:03   

Z pliku zawierającego makro....zmienna oznacza że za każdym razem będzie chodziło o inną nazwę folderu docelowego
_________________
Ł.B
ID posta: 361924 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 04-02-2019, 15:20   

Czy masz "swoje makro" i czy potrafisz wprowadzać zmiany do kodu, czy też jest ci to bardziej obce jak swojskie ?
Pytam, bo w wyszukiwarce forumowej można znaleźć pewne rzeczy, pytanie czy umie się z nich sorzystać .. od razu ... po przeróbce itp., np.:
http://www.excelforum.pl/...r-windowsa.html
ID posta: 361925 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2659 razy
Posty: 8828
Wysłany: 04-02-2019, 15:28   

I poskładaj to sobie do kupy
Kod:
Sub AAA()
  Dim strSciezkaZrodla As String
  Dim strSciezkaCelu As String
  Dim strSep As String
 
  strSep = Application.PathSeparator
  strSciezkaZrodla = ThisWorkbook.Path & strSep & "SZABLONY" & strSep & "Rejestr zmian.xlsx"
  strSciezkaCelu = ThisWorkbook.Path & strSep & "RECEPTY" & strSep & Range("AA10").Value
 
  'tu kopiowanie z... do...
End Sub

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 361926 Skopiuj do schowka
 
 
huraganbzq 
świeżak


Posty: 5
Wysłany: 04-02-2019, 15:40   

Coś tam potrafię ale generalnie niewiele...zawiesiłem się na tym nieszczęsnym thisworkbook.path...
Napisałem makro które z głównego pliku przenosi mi dane do tabelki w innym pliku i wkleja w pierwszy wolny wiersz...potem tworzy w folderze recepty folder o zadanej nazwie i hiperłącze do niego...tylko teraz chciałbym aby następnie przekopiowywało do tego folderu z hiperłączem ten plik rejestr zmian z folderu szablonyaby nie trzeba było za każdym razem kopiować go ręcznie...naszukałem się ale gotowe przykłady dotyczą sztywnej ścieżki dostępu a ja koniecznie potrzebuje aby to działało nawet po przeniesieniu folderu głównego gdzie indziej
_________________
Ł.B
ID posta: 361928 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2659 razy
Posty: 8828
Wysłany: 04-02-2019, 15:48   

To teraz przejdźmy do konkretów.
Załącz plik z dotychczasową pracą, by było widać o czym mamy rozmawiać.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 361929 Skopiuj do schowka
 
 
huraganbzq 
świeżak


Posty: 5
Wysłany: 05-02-2019, 13:19   

Plik z załącznikiem!!

Tak jeszcze raz w skrócie co chce zrobić...

W pliku GENERATOR RECEPT po uruchomieniu makra DOZESTAWIENIA....przenosi mi dane do pliku RECEPTURY...wkleja w pierwszy wolny wiersz po czym ostatnie 3 linijki kodu aktywują makro z VB ( w pliku RECEPTURY )które na podstawie nazwy z kolumny DB tworzy w folderze recepty nowy folder z hiperłączem do niego w kolumnie DB....i teraz chciałbym aby z folderu SZABLONY automatycznie przeniosło mi plik REJESTR ZMIAN do tego nowo utworzonego folderu....kolejne makro z pliku GENERATOR RECEPT ( UTWÓRZ ) ma przenieść z niego dane do tego wklejonego automatycznie do nowego folderu pliku REJESTR ZMIAN...chciałbym aby to wszystko działało za jednym uruchomieniem a póki co muszę działać na oddzielnych kodach bo blokuje mnie ręczne kopiowanie szablonu REJESTR ZMIAN

edycja Zbiniek:
Nie cytuj całej wypowiedzi znajdującej się bezpośrednio powyżej – w takim przypadku wiadomo, że się do niej odnosisz. Cytowanie stosuj tylko wtedy, gdy nawiązujesz do wypowiedzi o kilka postów wcześniej lub gdy komentujesz tylko jakiś fragment ostatniej wypowiedzi. W obu przypadkach zacytuj tylko fragment, do którego się odnosisz.


Nowy folder.zip
Dotyczczasowe wypociny :-)
Pobierz Plik ściągnięto 14 raz(y) 251.54 KB

_________________
Ł.B
ID posta: 361996 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2659 razy
Posty: 8828
Wysłany: 08-02-2019, 05:00   

1. Przynajmniej na razie, nie widzę potrzeby stosowania odwołania do RECEPTURY.xlsm w komórce X10 arkusza GENERATOR.
2. Niejednoznaczny kod w module arkusza Zestaw receptur w pliku RECEPTURY. Zmienna zakres = DB3:DB140, a info pod koniec procedury mówi o zakresie DB3:DB14. Przy okazji, choć to nie błąd, stosuj wielkie litery w nazwach kolumn (nie db3:db14, a DB3:DB14) tak w informacjach dla użytkownika, jak i w samym kodzie.
3. Wspomniana wyżej procedura zdarzeniowa nie działa prawidłowo, gdy edytuję "pustą" komórkę np. DB11. Powstanie folder o nazwie "(...)\RECEPTY\-".
4. A w ogóle to procedura ta jest niezbędna w tym arkuszu? Przewidujesz, że użytkownik będzie gmerał ręcznie w kolumnie DB? Jeśli odpowiedź brzmi NIE, to budowę hyperlinku należy zrealizować w makrze DOZESTAWIENIA.
5. Treść procedury UTWORZ nie jest adekwatna do zawartości Rejestr zmian, dlatego nie podłączam tej procedury do głównej.
6. Nie stosuj polskich znaków diakrytycznych w nazwach zmiennych i nazwach procedur. To jest proszenie się o kłopoty, nawet jeżeli na razie działa.

Kod się ciutkę wydłużył. :-)
Kod:
Sub DOZESTAWIENIA()
    Dim wksActv     As Worksheet
    Dim wkbRecpt    As Workbook
    Dim wksZestRecpt As Worksheet

    Dim wkbSzablon  As Workbook
    Dim wks         As Worksheet
    Dim lNowyWiersz As Long
    Dim lLp         As Long
    Dim strKod      As String
    Dim strLp_Kod   As String
    Dim strSep      As String
    Dim strSciezkaZrodla As String
    Dim strSciezkaCelu As String

    Set wksActv = ActiveSheet
    strSep = Application.PathSeparator

    Set wkbRecpt = Workbooks.Open(Filename:=ThisWorkbook.Path & strSep & "Receptury.xlsm")
    Set wksZestRecpt = wkbRecpt.Worksheets("Zestaw receptur")

    'oblicznie numeru nowego wiersza
    With wksZestRecpt.Range("A1").CurrentRegion
        lNowyWiersz = .Rows.Count + .Row
    End With

    If lNowyWiersz < 3 Then lNowyWiersz = 3

    'kopiuj ze źródła...
    wksActv.Range("A202:CZ202").Copy
    '... do celu
    wksZestRecpt.Range("A" & lNowyWiersz).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                                                       Operation:=xlNone, SkipBlanks:=False, _
                                                       Transpose:=False
    'wzbudź zdarzenie w kolumnie DB
    With wksZestRecpt.Range("DB" & lNowyWiersz)
        .Copy .Cells
    End With

    lLp = wksZestRecpt.Range("DA" & lNowyWiersz).Value
    strKod = wksZestRecpt.Range("U" & lNowyWiersz).Value
    strLp_Kod = lLp & "-" & strKod
    'lub
    'strLp_Kod = wksZestRecpt.Range("DB" & lNowyWiersz).Value

    'jl. komórka AA10 jest wykorzystywana TYLKO do wykonania makra UTWORZ,
    'to poniższą linię kodu można wyrzucić.  Wtedy należy usunąć także komórkę X10 i AA10, jako zbędne.
    'Do X10 w arkuszu źródłowym wpisz nową Lp. (formuła usunięta)
    wksActv.Range("X10").Value = lLp

    Application.CutCopyMode = False

    strSciezkaZrodla = ThisWorkbook.Path & strSep & "SZABLONY" & strSep & "Rejestr zmian.xlsm"
    strSciezkaCelu = ThisWorkbook.Path & strSep & "RECEPTY" & strSep & strLp_Kod

    If CheckOrCreateMultiFolders(strSciezkaCelu) Then
        strSciezkaCelu = strSciezkaCelu & strSep & "Rejestr zmian.xlsm"
        If fnCopyFile(strSciezkaZrodla, strSciezkaCelu) Then
          Stop
          'tu wywołanie innego makra (być może UTWORZ)
          '...
          'Call UTWORZ
        Else
          MsgBox "Coś poszło nie tak z kopiowaniem szablonu!", vbCritical
        End If
    Else
        MsgBox "Brak dostępu do folderu:" & vbLf & strSciezkaCelu, vbCritical
    End If

End Sub


Function CheckOrCreateMultiFolders(strPath As String) As Boolean
    'sprawdza, czy cała ścieżka do foderu istnieje
    'jl. nie, to próbuje ją utworzyć
    'funkcja zwraca:
    ' True - gdy cała ścieżka istnieje lub została pomyślnie utworzona
    ' False - gdy tworzenie się nie powiodło (np. z powodu braku uprawnień)

    Dim retVal      As Long

    If CreateObject("Scripting.FileSystemObject").FolderExists(strPath) Then
        CheckOrCreateMultiFolders = True
    Else
        retVal = CreateObject("Wscript.Shell").Run("cmd /c " & "md """ & strPath & """", 0, True)
        CheckOrCreateMultiFolders = (retVal = 0)
    End If

End Function


Function fnCopyFile(SourceFileName As String, TargetFileName As String) As Boolean
    Dim objFs As Object
    Dim Tm As Date
   
    Set objFs = CreateObject("Scripting.FileSystemObject")
   
    If objFs.FileExists(SourceFileName) Then
        objFs.CopyFile SourceFileName, TargetFileName
    End If
   
    Tm = Time + TimeSerial(0, 0, 5)
   
    'sprawdź, czy plik się skopiował
    'procedura oczekuje max 5 sek. Jeżeli pliku w tym czasie nie ma,
    'to funkcja zwróci False
    Do
      fnCopyFile = objFs.FileExists(TargetFileName)
    Loop Until fnCopyFile = True Or Tm < Time
   
    Set objFs = Nothing
   
End Function

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 362185 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 08-02-2019, 12:25   

No tak to jest, jak się po nocach siedzi ... bez piwa oczywiście ... żeby choć inni "docenili" ... :->
Kod:
    If CheckOrCreateMultiFolders(strSciezkaCelu) Then
         '...
         If fnCopyFile(strSciezkaZrodla, strSciezkaCelu) Then
           
           Stop    ' <==
           '...
         Else
         End If
     Else
     End If
ID posta: 362206 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2659 razy
Posty: 8828
Wysłany: 08-02-2019, 12:30   

Ależ to w pełni zamierzone.
Programista ma się w tym momencie zastanowić co ma zrobić dalej. Mówiłem, że procedura UTWORZ nie pasuje do zawartości pliku Rejestr zmian. Gdyby przynajmniej wizualnie mi pasowało, to Stop-u by nie było. :-)

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 362207 Skopiuj do schowka
 
 
huraganbzq 
świeżak


Posty: 5
Wysłany: 13-02-2019, 08:40   

Dziękuje bardzo za pomoc....wszystko działa perfekcyjnie :-)
_________________
Ł.B
ID posta: 362493 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe