Sub PublishFile()
Dim strDirectoryList As String
Dim lStr_Dir As String
Dim lInt_FreeFile01 As Integer
Dim lInt_FreeFile02 As Integer
 
On Error GoTo Err_Handler
    lStr_Dir = ThisWorkbook.Path
    lInt_FreeFile01 = FreeFile
    lInt_FreeFile02 = FreeFile
 
    strDirectoryList = lStr_Dir & "\Directory"
 
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")
 
    Open strDirectoryList & ".txt" For Output As #lInt_FreeFile01
''' Соединение с сайтом
    Print #lInt_FreeFile01, "open www.sani4.ru"
''' Логин
    Print #lInt_FreeFile01, "LOGIN"
''' Пароль
    Print #lInt_FreeFile01, "PASSWORD"
''' Куда положить
    Print #lInt_FreeFile01, "cd zakazi/demo/img"
    Print #lInt_FreeFile01, "binary"
''' Откуда ThisWorkbook.Path & "\grafik.jpg
''' Куда указывали выше и как назвать grafik.jpg"
    Print #lInt_FreeFile01, "send " & ThisWorkbook.Path & "\grafik.jpg grafik.jpg"
 
    Print #lInt_FreeFile01, "bye"
    Close #lInt_FreeFile01
 
    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
 
    Shell (strDirectoryList & ".bat"), vbHide
    Do While Dir(strDirectoryList & ".out") = ""
        DoEvents
    Loop
 
    Application.Wait (Now + TimeValue("0:00:03"))
 
    If Dir(strDirectoryList & ".bat") <> "" Then Kill (strDirectoryList & ".bat")
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")
    If Dir(strDirectoryList & ".txt") <> "" Then Kill (strDirectoryList & ".txt")
 
bye:
 
Exit Sub
 
Err_Handler:
    MsgBox "Error : " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical
    Resume bye
 
End Sub