Uploading file automatically in web server

dmarop

Registered User.
Local time
Today, 08:21
Joined
May 17, 2013
Messages
41
Hello,

I will need your help. I want through Access with vba to upload automatically a file image in a web server.

I find the following code in a lot of places to the internet but I can’t modify it in my own case.

Code:
Option Compare Database
Option Explicit

'Open the Internet object
Private Declare Function InternetOpen _
                          Lib "wininet.dll" _
                              Alias "InternetOpenA" _
                              (ByVal sAgent As String, _
                               ByVal lAccessType As Long, _
                               ByVal sProxyName As String, _
                               ByVal sProxyBypass As String, _
                               ByVal lFlags As Long) As Long

'Connect to the network
Private Declare Function InternetConnect _
                          Lib "wininet.dll" _
                              Alias "InternetConnectA" _
                              (ByVal hInternetSession As Long, _
                               ByVal sServerName As String, _
                               ByVal nServerPort As Integer, _
                               ByVal sUsername As String, _
                               ByVal sPassword As String, _
                               ByVal lService As Long, _
                               ByVal lFlags As Long, _
                               ByVal lContext As Long) As Long

'Get a file using FTP
Private Declare Function FtpGetFile _
                          Lib "wininet.dll" _
                              Alias "FtpGetFileA" _
                              (ByVal hFtpSession As Long, _
                               ByVal lpszRemoteFile As String, _
                               ByVal lpszNewFile As String, _
                               ByVal fFailIfExists As Boolean, _
                               ByVal dwFlagsAndAttributes As Long, _
                               ByVal dwFlags As Long, _
                               ByVal dwContext As Long) As Boolean

'Send a file using FTP
Private Declare Function FtpPutFile _
                          Lib "wininet.dll" _
                              Alias "FtpPutFileA" _
                              (ByVal hFtpSession As Long, _
                               ByVal lpszLocalFile As String, _
                               ByVal lpszRemoteFile As String, _
                               ByVal dwFlags As Long, _
                               ByVal dwContext As Long) As Boolean

'Close the Internet object
Private Declare Function InternetCloseHandle _
                          Lib "wininet.dll" _
                              (ByVal hInet As Long) As Integer

Sub AutoClose()

    Dim INet As Long
    Dim INetConn As Long
    Dim hostFile As String
    Dim localFile As String
    Dim Password As String
    Dim RetVal As Long
    Dim ServerName As String
    Dim Success As Long
    Dim UserName As String
    Dim currentFileAndPath As String

    Const ASCII_TRANSFER = 1
    Const BINARY_TRANSFER = 2
    
    ServerName = "ftp.yourserver.com"
    UserName = "username"
    Password = "yourpassword"

    currentFileAndPath = ActiveDocument.FullName
    ActiveDocument.SaveAs ("C:\img2676858.jpg")
    ActiveDocument.SaveAs (currentFileAndPath)

    localFile = "C:\img2676858.jpg"
    hostFile = ActiveDocument.Name

    If Len(ActiveDocument.Path) = 0 Then
        MsgBox "The document must be saved first."
        Exit Sub
    End If

    RetVal = False
    INet = InternetOpen("MyFTP Control", 1&, vbNullString, vbNullString, 0&)
    If INet > 0 Then
        INetConn = InternetConnect(INet, ServerName, 0&, UserName, Password, 1&, 0&, 0&)
        If INetConn > 0 Then
            Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&)
            RetVal = InternetCloseHandle(INetConn)
        End If
        RetVal = InternetCloseHandle(INet)
    End If

    If Success <> 0 Then
        MsgBox ("Upload process completed")
    Else
        MsgBox "FTP File Error!"
    End If

End Sub

I try to solve the problem but this is not possible. Can you help me for the solution?

Thank you in advance.

Regards,
Dimitris
 

Users who are viewing this thread

Back
Top Bottom