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: 75883 Skopiuj do schowka Tworzenie pdf-a i wysyłaka na serwer ftp
Autor Wiadomość
partner2001 
Exceloholic


Wersja: Win Office 365
Posty: 217
Wysłany: 31-05-2024, 14:07   Tworzenie pdf-a i wysyłaka na serwer ftp

Witam.
Mam procedurę która tworzy plik pdf-a z dwóch arkuszy excela i nastepnie powinna go wysłać na serwer ftp. Coś pochrzaniłem i plik się tworzy ale nie wysyła się na serwer ftp.
Co zrobiłem nie tak?
Kod:
Sub Publikuj_do_PDF()
    Dim shActv      As Object
    Dim strFName    As String
    Dim strFullPath As String
    'zapamiętaj aktywny arkusz
    Set shActv = ActiveSheet
   
    'pobierz nazwę pliku
    'dalej założono, że nazwa nie zawiera niedozwolonych znaków
    strFName = Sheets("info").Range("A1").Value
   
    If Len(Trim(strFName)) = 0 Then
      MsgBox "Brak nazwy pliku.", vbExclamation, " Publikuj PDF"
      Exit Sub
    End If
   
    'jl. brak rozszerzenia w nazwie, to go dodaj
    If LCase(Right(strFName, 4)) <> ".pdf" Then
        strFName = strFName & ".pdf"
    End If
   
    'ścieżka do folderu w którym znajduje się skoroszyt
    ' strFullPath = ThisWorkbook.Path & "\" & strFName
    strFullPath = ThisWorkbook.Path & "\Wydruki"
    If Dir(strFullPath, vbDirectory) = "" Then MkDir strFullPath
    strFullPath = strFullPath & "\" & strFName
   
    Application.ScreenUpdating = False
   
    'jl. skoroszyt zawiera więcej arkuszy niż wymienione poniżej
    'a zależy nam na publikacji tylko wymienionych
    Sheets(Array("lista_TG", "TG8")).Select
    Sheets("TG8").Activate

    'jl. chcemy opublikować cały skoroszyt
    'wtenczas dwie poprzednie linie są zbędne,
    'a w poniższej należy zamienić ActiveSheet na ActiveWorkbook (lub ThisWorkbook)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=strFullPath, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False 'lub True,
                                                           'gdy chcesz pokazywać po publikacji
     
     ' Wysyłka pliku na serwer ftp
     PublishFile strFullPath
                                           
     End If
     
 
    'zaznaczenie arkusza, który był aktywny przed uruchomieniem makra
    shActv.Select
   

End Sub

Sub PublishFile(fileToSend As String)

    Dim sServer As String, sLogin As String, sPassword As String, sPath As String
    Dim strDirectoryList As String
    Dim lStr_Dir As String
    Dim lInt_FreeFile01 As Integer
    Dim lInt_FreeFile02 As Integer
    Dim strFName As String

    ' On Error GoTo Err_Handler
   
    '************** Ustawienia **********
    sServer = "94.152.11.148"            'adres serwera
    sLogin = "danezpzts"          'login
    sPassword = "mojehasło"                   'hasło
    sPath = "public_html/danezpzts.pl/"                      'katalog na serwerze - jeżeli nie główny
    '********** Koniec ustawień *********
   
    'jako miejsce tworzenia plików roboczych ustawiamy katalog systemowy Temp
    lStr_Dir = Environ("Temp")
   
    lInt_FreeFile01 = FreeFile
    lInt_FreeFile02 = FreeFile
 
    strDirectoryList = lStr_Dir & "\Plik_Temp"

    '' Usunięcie pliku z zakończeniem transakcji - w zasadzie nie powinno go być
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")

    '' Utworzenie pliku txt z komendami FTP
    Open strDirectoryList & ".txt" For Output As #lInt_FreeFile01
    Print #lInt_FreeFile01, "open " & sServer
    Print #lInt_FreeFile01, sLogin
    Print #lInt_FreeFile01, sPassword
    Print #lInt_FreeFile01, "cd /" & sPath
    Print #lInt_FreeFile01, "binary"
    Print #lInt_FreeFile01, "send """ & fileToSend & """"
    Print #lInt_FreeFile01, "bye"
    Close #lInt_FreeFile01

    '' Utworzenie pliku bat
    Open strDirectoryList & ".bat" For Output As #lInt_FreeFile02
    Print #lInt_FreeFile02, "ftp -s:""" & strDirectoryList & ".txt"""

    Print #lInt_FreeFile02, "Echo ""Complete"" > """ & strDirectoryList & ".out"""
    Close #lInt_FreeFile02

    '' uruchomienie pliku bat
    Shell """" & strDirectoryList & ".bat""", vbHide
    'Czekamy na ukończenie przesyłu
    Do While Dir(strDirectoryList & ".out") = ""
        DoEvents
    Loop

    Application.Wait (Now + TimeValue("0:00:03"))

    ' Czyszczenie plików tymczasowych
    If Dir(strDirectoryList & ".bat") <> "" Then Kill (strDirectoryList & ".bat")
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")
    If Dir(strDirectoryList & ".txt") <> "" Then Kill (strDirectoryList & ".txt")
    ' If Dir(lStr_Dir & "\" & sNazwaStrony) <> "" Then Kill (lStr_Dir & "\" & sNazwaStrony)

    MsgBox "Jeśli masz połączenie z internetem i nie ma awarii na serwerze ZPZTS &#8211; diagram został wysłany na serwer ZPZTS"
bye:

    Exit Sub
_________________
Dziękuję za pomoc.
Pozdrawiam
Leszek
ID posta: 435613 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.wip.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