Snasui Excel Forum

Code: Select all

Sub Sendmail()

    Dim inputValue As Variant
    Dim FTPusername As String, FTPpassword As String
    Dim filenum As Integer
    Dim FTPcommand As String
    Dim wsh As Object
    Dim fileName As String
    
    file_path = Range("b3").Value
    inputValue = InputBox("Enter username", cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPusername = CStr(inputValue)
    
    inputValue = InputBox("Enter password for username " & FTPusername, cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPpassword = CStr(inputValue)
    
    'Create file containing ftp commands.  The file has to contain the username and password
    'to connect to the ftp server.  Creating the file and deleting it immediately after use gives some degree of
    'security in preference to having a static file containing the username and password
    
    fileName = Dir(file_path & "\*.xls")
    Do While Len(fileName) > 0
        filenum = FreeFile
        Open cFTPCommandsFile For Output As #filenum
        Print #filenum, "!REM upload .csv file"             'Use !REM for comments with a Windows ftp server
        'Print #filenum, "!# upload .csv file"              'Use '# for comments with a Unix ftp server
        Print #filenum, "open " & cFTPServer & " " & cFTPPort
        Print #filenum, "user " & FTPusername & " " & FTPpassword
        Print #filenum, "cd Website-Search"
        Print #filenum, "binary"
        Print #filenum, "put " & QQ(file_path & "\" & fileName)
        
        
        'The next line is temporarily commented out to omit the bye command from the ftp commands script.
        'This keeps the command window open to show whether the ftp commands worked successfully or not.
        'If the bye command is omitted you must type bye in the command window to exit ftp and end this procedure
        
        'Print #filenum, "bye"
        Close #filenum
        
        'Construct ftp command line, specifying the file containing FTP commands.  The -n parameter suppresses auto-login
        'upon initial connection because we want to use the username and password specified in the command file
        
        FTPcommand = "ftp -i -n -s:" & QQ(cFTPCommandsFile)
        
        'Run ftp command synchronously, waiting for the command to return
        'WindowStyle 1 displays the command window. Use this, together with omitting the bye command, to verify
        'whether or not the ftp commands worked successfully.
        'WindowStyle 0 hides the command window.
        'See http://msdn.microsoft.com/en-us/library/d5fk67ky%28VS.85%29.aspx
        
        CreateObject("WScript.Shell").Run Command:=FTPcommand, WindowStyle:=1, waitonreturn:=True
            
        'Delete the ftp commands file so that the username and password are not left lying around
        
        Kill cFTPCommandsFile
        
        fileName = Dir
    Loop
    
    MsgBox "Finished"



End Sub

Code: Select all

Sub SendFileViaFTP_Click()
    Dim inputValue As Variant
    Dim FTPusername As String, FTPpassword As String
    Dim filenum As Integer
    Dim FTPcommand As String
    Dim wsh As Object
    Dim fileName As String
    
    file_path = Range("b3").Value
    inputValue = InputBox("Enter username", cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPusername = CStr(inputValue)
    
    inputValue = InputBox("Enter password for username " & FTPusername, cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPpassword = CStr(inputValue)
    
    'Create file containing ftp commands.  The file has to contain the username and password
    'to connect to the ftp server.  Creating the file and deleting it immediately after use gives some degree of
    'security in preference to having a static file containing the username and password
    
    fileName = Dir(file_path & "\*.xls")
    Do While Len(fileName) > 0
        filenum = FreeFile
        Open cFTPCommandsFile For Output As #filenum
        Print #filenum, "!REM upload .csv file"             'Use !REM for comments with a Windows ftp server
        'Print #filenum, "!# upload .csv file"              'Use '# for comments with a Unix ftp server
        Print #filenum, "open " & cFTPServer & " " & cFTPPort
        Print #filenum, "user " & FTPusername & " " & FTPpassword
        Print #filenum, "cd Website-Search"
        Print #filenum, "binary"
        Print #filenum, "put " & QQ(file_path & "\" & fileName)
        
        
        'The next line is temporarily commented out to omit the bye command from the ftp commands script.
        'This keeps the command window open to show whether the ftp commands worked successfully or not.
        'If the bye command is omitted you must type bye in the command window to exit ftp and end this procedure
        
        'Print #filenum, "bye"
        Close #filenum
        
        'Construct ftp command line, specifying the file containing FTP commands.  The -n parameter suppresses auto-login
        'upon initial connection because we want to use the username and password specified in the command file
        
        FTPcommand = "ftp -i -n -s:" & QQ(cFTPCommandsFile)
        
        'Run ftp command synchronously, waiting for the command to return
        'WindowStyle 1 displays the command window. Use this, together with omitting the bye command, to verify
        'whether or not the ftp commands worked successfully.
        'WindowStyle 0 hides the command window.
        'See http://msdn.microsoft.com/en-us/library/d5fk67ky%28VS.85%29.aspx
        
        CreateObject("WScript.Shell").Run Command:=FTPcommand, WindowStyle:=1, waitonreturn:=True
            
        'Delete the ftp commands file so that the username and password are not left lying around
        
        Kill cFTPCommandsFile
        
        fileName = Dir
    Loop
    
    MsgBox "Finished"

Code: Select all

'download File to FTP
Const cFTPServer As String = "ftp.svi.co.th"     'CHANGE THIS.
Const cFTPPort = 21
Const cFTPCommandsFile As String = "FTP_commands.txt"

Sub SendFileViaFTP_Click()
    Dim inputValue As Variant
    Dim FTPusername As String, FTPpassword As String
    Dim filenum As Integer
    Dim FTPcommand As String
    Dim wsh As Object
    
    File_Path = Range("b3").Value
    inputValue = InputBox("Enter username", cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPusername = CStr(inputValue)
    
    inputValue = InputBox("Enter password for username " & FTPusername, cFTPServer)
    If inputValue = False Or inputValue = "" Then Exit Sub
    FTPpassword = CStr(inputValue)
    
    'Create file containing ftp commands.  The file has to contain the username and password
    'to connect to the ftp server.  Creating the file and deleting it immediately after use gives some degree of
    'security in preference to having a static file containing the username and password
    
    filenum = FreeFile
    Open cFTPCommandsFile For Output As #filenum
    Print #filenum, "!REM upload .csv file"             'Use !REM for comments with a Windows ftp server
    'Print #filenum, "!# upload .csv file"              'Use '# for comments with a Unix ftp server
    Print #filenum, "open " & cFTPServer & " " & cFTPPort
    Print #filenum, "user " & FTPusername & " " & FTPpassword
    Print #filenum, "cd Website-Search"
    Print #filenum, "binary"
    Print #filenum, "put " & QQ(File_Path & "\" & "*.xlsx")
    
    'The next line is temporarily commented out to omit the bye command from the ftp commands script.
    'This keeps the command window open to show whether the ftp commands worked successfully or not.
    'If the bye command is omitted you must type bye in the command window to exit ftp and end this procedure
    
    'Print #filenum, "bye"
    Close #filenum
    
    'Construct ftp command line, specifying the file containing FTP commands.  The -n parameter suppresses auto-login
    'upon initial connection because we want to use the username and password specified in the command file
    
    FTPcommand = "ftp -i -n -s:" & QQ(cFTPCommandsFile)
    
    'Run ftp command synchronously, waiting for the command to return
    'WindowStyle 1 displays the command window. Use this, together with omitting the bye command, to verify
    'whether or not the ftp commands worked successfully.
    'WindowStyle 0 hides the command window.
    'See http://msdn.microsoft.com/en-us/library/d5fk67ky%28VS.85%29.aspx
    
    CreateObject("WScript.Shell").Run Command:=FTPcommand, WindowStyle:=1, waitonreturn:=True
        
    'Delete the ftp commands file so that the username and password are not left lying around
    
    Kill cFTPCommandsFile
    
    MsgBox "Finished"



End Sub
Private Function QQ(text As String) As String
    QQ = Chr(34) & text & Chr(34)
End Function

Code: Select all

'download File to FTP
Sub SendFileViaFTP_Click()

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

    '' ANW  07-Feb-2003 :
    strDirectoryList = lStr_Dir & "\Directory"

    '' Delete completion file
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")

    '' Create text file with FTP commands
    Open strDirectoryList & ".txt" For Output As #lInt_FreeFile01
    Print #lInt_FreeFile01, "ftp.svi.co.th"
    Print #lInt_FreeFile01, "100001"
    Print #lInt_FreeFile01, "9922"
    Print #lInt_FreeFile01, "cd source/uploads"
    Print #lInt_FreeFile01, "binary"
    Print #lInt_FreeFile01, "send " & ThisWorkbook.path & "\test.txt"

    '' To receive a file, replace the above line with this one
    ''Print #lInt_FreeFile01, "recv \Picture.gif " & ThisWorkbook.Path & "\Picture.gif"
    
    Print #lInt_FreeFile01, "bye"
    Close #lInt_FreeFile01

    '' Create Batch program
    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

    '' Invoke Directory List generator
    Shell (strDirectoryList & ".bat"), vbHide '', vbMinimizedNoFocus
    'Wait for completion
    Do While Dir(strDirectoryList & ".out") = ""
        DoEvents
    Loop

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

    '' Clean up files
    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