Uploading query results to a website 1

osp001 · Nov 5, 2004

I need some help figuring out how to take my results- a query in .html format- and uploading them to my website. Right now, I dump the finished product to a disk, move it to another computer where I have my FTP program, and then upload it manually.

Is there any way to arrange for Access to finish the query, and FTP it for me? Or am I just dreaming?

Thanks!

eireanacht · Nov 9, 2004

The short answer is yes, you can do it in Access. I have two Access modules called FTPClent and Test which work quite well. I'll post both. Please let me know if it works for you or if you need explanation. Hope they help.

First module:

Code:

Sub TestFTP1()

    On Error GoTo TestFTP1_Err
    'DoCmd.Hourglass True
    With New FTPClient
        .ServerName = "[URL unfurl="true"]www.anyserver.com"[/URL]
        .UserName = "loginName"
        .Password = "password"
        .LocalFile = "C:\somepath\resultingFile.txt"
        .RemoteDir = "./[URL unfurl="true"]www/destinationPath"[/URL]
        .RemoteFile = "resultingFile.txt"
        .TransferType = "ASC"
        .OpenFTP
            .OpenServer
                .PutFile
            .CloseServer
        .CloseFTP
    End With
    'DoCmd.Hourglass False

TestFTP1_Exit:
    Exit Sub

TestFTP1_Err:
    MsgBox Err.Description, vbCritical
    Resume TestFTP1_Exit
    
End Sub

Sub TestFTP2()
'Functionally equivalent to TestFTP1
'Shows alternative syntax

    On Error GoTo TestFTP2_Err

    DoCmd.Hourglass True
    With New FTPClient
        .OpenFTP
            .OpenServer "[URL unfurl="true"]www.someserver.com",[/URL] "username", "password"
                .PutFile , "resultFile.txt", "d:\localpath\resultFile.txt"
            .CloseServer
        .CloseFTP
    End With
    DoCmd.Hourglass False

TestFTP2_Exit:
    Exit Sub

TestFTP2_Err:
    MsgBox Err.Description, vbCritical
    Resume TestFTP2_Exit

End Sub

Sub TestFTP3()

    Dim strTemp As String
    Dim i As Integer
    '
    On Error GoTo TestFTP3_Err

    With New FTPClient
        DoCmd.Hourglass True
        .OpenFTP
            'Log in as Anonymous with email
            'address as password
            .OpenServer "server.domain.com"
                .FileSpec = "*.htm"
                .RemoteDir = "."
                .GetFileNames
            .CloseServer
        .CloseFTP
        DoCmd.Hourglass False
        'List the first 10 matching files
        'in a MessageBox
        With .FileNames
            strTemp = "Number of files found: " & .Count & vbCrLf & vbCrLf
            For i = 1 To .Count
                strTemp = strTemp & .Item(i) & vbCrLf
                'Kludge for this example, so we
                'don't overfill MsgBox
                If i > 10 Then Exit For
            Next
        End With
        MsgBox strTemp
        'Remove all members from collection
        '(No need for this here, because the
        'Class_Terminate will do it anyway.
        'Shown for completeness)
        .ClearFileNames
    End With
        
TestFTP3_Exit:
    Exit Sub

TestFTP3_Err:
    MsgBox Err.Description, vbCritical
    Resume TestFTP3_Exit

End Sub

Second module:

Code:

Option Compare Database
Option Explicit
'
'''''''''''''''''''''''''''''''
'Member Variables
'''''''''''''''''''''''''''''''
Private m_ProxyName     As String
Private m_RemoteDir     As String
Private m_RemoteFile    As String
Private m_NewFileName   As String
Private m_LocalFile     As String
Private m_ServerName    As String
Private m_UserName      As String
Private m_Password      As String
Private m_TransferType  As Long
Private m_FileSpec      As String
'
'''''''''''''''''''''''''''''''
'Collections
'''''''''''''''''''''''''''''''
Public FileNames As New Collection
'
'''''''''''''''''''''''''''''''
'Private Variables
'''''''''''''''''''''''''''''''
Private m_hFTP As Long  'Handle to the FTP session
Private m_hCon As Long  'Handle to the server connection
'
'''''''''''''''''''''''''''''''
'Private Constants
'''''''''''''''''''''''''''''''
Private Const mc_AGENTNAME = "FTP Class"
'
'''''''''''''''''''''''''''''''
'Error values (See the RaiseError routine)
'''''''''''''''''''''''''''''''
Private Const errOpenFTP      As String = "1;Call to InternetOpen failed."
Private Const errOpenCon      As String = "2;Call to InternetConnect failed."
Private Const errGetFile      As String = "3;Call to FtpGetFile failed."
Private Const errPutFile      As String = "4;Call to FtpPutFile failed."
Private Const errDelFile      As String = "5;Call to FtpDeleteFile failed."
Private Const errRenFile      As String = "6;Call to FtpRenameFile failed."
Private Const errGetDir       As String = "7;Call to FtpGetCurrentDirectory failed."
Private Const errSetDir       As String = "8;Call to FtpSetCurrentDirectory failed."
Private Const errCreateDir    As String = "9;Call to FtpCreateDirectory failed."
Private Const errFindFirst    As String = "10;Call to FtpFindFirstFile failed."
Private Const errFindNext     As String = "11;Call to InternetFindNextFile failed."
Private Const errDelDir       As String = "12;Call to FtpRemoveDirectory failed."
Private Const errNotOpen      As String = "13;FTP session not open. Call OpenFTP first."
Private Const errNotConnected As String = "14;Not connected to a server. Call OpenServer first."
Private Const errNoServer     As String = "15;No Server Name specified."
Private Const errNoLocalFile  As String = "16;No Local File specified."
Private Const errNoRemoteFile As String = "17;No Remote File specified."
'
'''''''''''''''''''''''''''''''
'API Declarations
'''''''''''''''''''''''''''''''
Private Const MAX_PATH = &H104
'
Private Const INTERNET_INVALID_PORT_NUMBER = &H0
Private Const INTERNET_SERVICE_FTP = &H1
Private Const INTERNET_OPEN_TYPE_DIRECT = &H1
Private Const INTERNET_OPEN_TYPE_PROXY = &H3
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
'
Private Const FTP_TRANSFER_TYPE_ASCII = &H0
Private Const FTP_TRANSFER_TYPE_BINARY = &H1
'
Private Const NO_ERROR = &H0
Private Const ERROR_NO_MORE_FILES = &H12
Private Const ERROR_INTERNET_EXTENDED_ERROR = &H2EE3
'
Private Type FILETIME
    dwLowDateTime  As Long
    dwHighDateTime As Long
End Type
'
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime   As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime  As FILETIME
    nFileSizeHigh    As Long
    nFileSizeLow     As Long
    dwReserved0      As Long
    dwReserved1      As Long
    cFileName        As String * MAX_PATH
    cAlternate       As String * 14
End Type
'
Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
    Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
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
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
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" _
    Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" _
    (ByVal hFtpSession As Long, ByVal lpszExistFile As String, ByVal lpszNewFile As String) As Boolean
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer
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
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
    (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
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

'''''''''''''''''''''''''''''''
'Properties
'''''''''''''''''''''''''''''''
Public Property Get ProxyName() As String
    ProxyName = m_ProxyName
End Property
Public Property Let ProxyName(NewData As String)
    m_ProxyName = NewData
End Property

Public Property Get RemoteDir() As String
    RemoteDir = m_RemoteDir
End Property
Public Property Let RemoteDir(NewData As String)
    m_RemoteDir = NewData
End Property

Public Property Get RemoteFile() As String
    RemoteFile = m_RemoteFile
End Property
Public Property Let RemoteFile(NewData As String)
    m_RemoteFile = NewData
End Property

Public Property Get LocalFile() As String
    LocalFile = m_LocalFile
End Property
Public Property Let LocalFile(NewData As String)
    m_LocalFile = NewData
End Property

Public Property Let NewFileName(NewData As String)
    m_NewFileName = NewData
End Property

Public Property Get ServerName() As String
    ServerName = m_ServerName
End Property
Public Property Let ServerName(NewData As String)
    m_ServerName = NewData
End Property

Public Property Get UserName() As String
    UserName = m_UserName
End Property
Public Property Let UserName(NewData As String)
    m_UserName = NewData
End Property

Public Property Get Password() As String
    Password = m_Password
End Property
Public Property Let Password(NewData As String)
    m_Password = NewData
End Property

Public Property Get TransferType() As String
    TransferType = IIf(m_TransferType = FTP_TRANSFER_TYPE_BINARY, "BINARY", "ASCII")
End Property
Public Property Let TransferType(NewData As String)
    m_TransferType = IIf(UCase(Left(NewData, 3)) = "BIN", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII)
End Property

Public Property Get FileSpec() As String
    FileSpec = m_FileSpec
End Property
Public Property Let FileSpec(NewData As String)
    m_FileSpec = NewData
End Property

'''''''''''''''''''''''''''''''
'Methods
'''''''''''''''''''''''''''''''
Public Sub OpenFTP(Optional pProxyName)
'Initiate FTP session

    'Handle optional parameters
    If Not IsMissing(pProxyName) Then m_ProxyName = pProxyName
    '
    If Len(m_ProxyName) Then
        m_hFTP = InternetOpen(mc_AGENTNAME, INTERNET_OPEN_TYPE_PROXY, _
            m_ProxyName, vbNullString, 0)
    Else
        m_hFTP = InternetOpen(mc_AGENTNAME, INTERNET_OPEN_TYPE_DIRECT, _
            vbNullString, vbNullString, 0)
    End If
    If m_hFTP = 0 Then RaiseError errOpenFTP

End Sub

Public Sub CloseFTP()
'Terminate FTP session

    If m_hCon Then Me.CloseServer
    If m_hFTP Then InternetCloseHandle m_hFTP
    m_hCon = 0
    m_hFTP = 0
    
End Sub

Public Sub OpenServer(Optional pServerName, Optional pUserName, Optional pPassword)
'Establish connection to server

    'If FTP session not initiated
    If m_hFTP = 0 Then RaiseError errNotOpen
    '
    'Handle optional parameters
    If Not IsMissing(pServerName) Then m_ServerName = pServerName
    If Not IsMissing(pUserName) Then m_UserName = pUserName
    If Not IsMissing(pPassword) Then m_Password = pPassword
    '
    'Handle empty properties
    If Len(m_ServerName) = 0 Then RaiseError errNoServer
    '
    'The following are translated to:
    '  UserName: Anonymous
    '  Password: default email address
    'by the API, if nulls passed
    If Len(m_UserName) = 0 Then m_UserName = vbNullString
    If Len(m_Password) = 0 Then m_Password = vbNullString
    '
    m_hCon = InternetConnect(m_hFTP, m_ServerName, INTERNET_INVALID_PORT_NUMBER, _
                                  m_UserName, m_Password, INTERNET_SERVICE_FTP, _
                                  INTERNET_FLAG_PASSIVE, 0)
    If m_hCon = 0 Then RaiseError errOpenCon
    
End Sub

Public Sub CloseServer()
'Terminate connection to server

    If m_hCon Then InternetCloseHandle m_hCon
    m_hCon = 0
    
End Sub

Public Sub GetFile(Optional pRemoteDir, Optional pRemoteFile, _
                   Optional pLocalFile, Optional pTransferType)
'Retrieve a file from server
'pTransferType accepts "ASCII" or "BINARY"

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
    If Not IsMissing(pLocalFile) Then m_LocalFile = pLocalFile
    If Not IsMissing(pTransferType) Then Me.TransferType = pTransferType
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
    If Len(m_LocalFile) = 0 Then RaiseError errNoLocalFile
    If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
    '
    'Change directory on server
    Me.SetDir m_RemoteDir
    '
    If FtpGetFile(m_hCon, m_RemoteFile, m_LocalFile, False, _
      INTERNET_FLAG_RELOAD, m_TransferType, 0) = False Then
        RaiseError errGetFile
    End If
        
End Sub

Public Sub PutFile(Optional pRemoteDir, Optional pRemoteFile, _
                   Optional pLocalFile, Optional pTransferType)
'Transmit a file to server
'pTransferType accepts "ASCII" or "BINARY"

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
    If Not IsMissing(pLocalFile) Then m_LocalFile = pLocalFile
    If Not IsMissing(pTransferType) Then Me.TransferType = pTransferType
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
    If Len(m_LocalFile) = 0 Then RaiseError errNoLocalFile
    If Len(m_TransferType) = 0 Then Me.TransferType = "BINARY"
    '
    'Change directory on server
    Me.SetDir m_RemoteDir
    '
    If FtpPutFile(m_hCon, m_LocalFile, m_RemoteFile, m_TransferType, 0) = False Then
        RaiseError errPutFile
    End If
        
End Sub

Public Sub DelFile(Optional pRemoteDir, Optional pRemoteFile)
'Delete a file on server

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    If Not IsMissing(pRemoteFile) Then m_RemoteFile = pRemoteFile
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
    '
    'Change directory on server
    Me.SetDir m_RemoteDir
    '
    If FtpDeleteFile(m_hCon, m_RemoteFile) = False Then
        RaiseError errDelFile
    End If
        
End Sub

Public Sub RenFile(Optional pOldName, Optional pNewName)
'Rename a file on server

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pOldName) Then m_RemoteFile = pOldName
    If Not IsMissing(pNewName) Then m_NewFileName = pNewName
    '
    'Handle empty properties
    If Len(m_RemoteFile) = 0 Then RaiseError errNoRemoteFile
    If Len(m_NewFileName) = 0 Then m_NewFileName = m_RemoteFile
    '
    'Change directory on server
    Me.SetDir m_RemoteDir
    '
    If FtpRenameFile(m_hCon, m_RemoteFile, m_NewFileName) = False Then
        RaiseError errRenFile
    End If
        
End Sub

Public Function GetDir() As String
'Determine current directory on server

    Dim Buffer As String
    Dim BufLen As Long
    '
    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    BufLen = MAX_PATH
    Buffer = String(BufLen, 0)
    If FtpGetCurrentDirectory(m_hCon, Buffer, BufLen) = False Then
        RaiseError errGetDir
    End If
    GetDir = Left(Buffer, BufLen)
    
End Function

Public Sub SetDir(Optional pRemoteDir)
'Change current directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    '
    If FtpSetCurrentDirectory(m_hCon, m_RemoteDir) = False Then
        RaiseError errSetDir
    End If
        
End Sub

Public Sub CreateDir(Optional pRemoteDir)
'Create directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    '
    If FtpCreateDirectory(m_hCon, m_RemoteDir) = False Then
        RaiseError errCreateDir
    End If
        
End Sub

Public Sub DelDir(Optional pRemoteDir)
'Delete directory on server

    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    '
    If FtpRemoveDirectory(m_hCon, m_RemoteDir) = False Then
        RaiseError errDelDir
    End If
        
End Sub

Public Sub GetFileNames(Optional pRemoteDir, Optional pFileSpec)
'Fill the FileNames collection with list
'of files matching pFileSpec from server's
'current directory

    Dim hFind As Long
    Dim LastErr As Long
    Dim fData As WIN32_FIND_DATA
    '
    'Bail out if server connection not established
    If m_hCon = 0 Then RaiseError errNotConnected
    '
    'Handle optional parameters
    If Not IsMissing(pRemoteDir) Then m_RemoteDir = pRemoteDir
    If Not IsMissing(pFileSpec) Then m_FileSpec = pFileSpec
    '
    'Handle empty properties
    If Len(m_RemoteDir) = 0 Then m_RemoteDir = "."
    If Len(m_FileSpec) = 0 Then m_FileSpec = "*.*"
    '
    'Change directory on server
    Me.SetDir m_RemoteDir
    '
    'Find first file matching FileSpec
    fData.cFileName = String(MAX_PATH, 0)
    'Obtain search handle if successful
    hFind = FtpFindFirstFile(m_hCon, m_FileSpec, fData, 0, 0)
    LastErr = Err.LastDllError
    If hFind = 0 Then
        'Bail out if reported error isn't end-of-file-list
        If LastErr <> ERROR_NO_MORE_FILES Then
            RaiseError errFindFirst
        End If
        'Must be no more files
        Exit Sub
    End If
    '
    'Reset variable for next call
    LastErr = NO_ERROR
    '
    'Add filename to the collection
    FileNames.Add Left(fData.cFileName, _
        InStr(1, fData.cFileName, vbNullChar, vbBinaryCompare) - 1)
    Do
        'Find next file matching FileSpec
        fData.cFileName = String(MAX_PATH, 0)
        If InternetFindNextFile(hFind, fData) = False Then
            LastErr = Err.LastDllError
            If LastErr = ERROR_NO_MORE_FILES Then
                'Bail out if no more files
                Exit Do
            Else
                'Must be a 'real' error
                InternetCloseHandle hFind
                RaiseError errFindNext
            End If
        Else
            'Add filename to the collection
            FileNames.Add Left(fData.cFileName, _
                InStr(1, fData.cFileName, vbNullChar, vbBinaryCompare) - 1)
       End If
    Loop
    '
    'Release the search handle
    InternetCloseHandle hFind

End Sub

Public Sub ClearFileNames()
'Clear contents of FileNames collection

    Dim itm As Long
    '
    With FileNames
        For itm = 1 To .Count
            .Remove 1
        Next
    End With
    
End Sub

Private Sub Class_Initialize()
'Set property defaults

    m_RemoteDir = "."
    m_RemoteFile = vbNullString
    m_LocalFile = vbNullString
    m_NewFileName = vbNullString
    m_UserName = vbNullString
    m_Password = vbNullString
    m_ProxyName = vbNullString
    m_ServerName = vbNullString
    m_TransferType = FTP_TRANSFER_TYPE_BINARY
    
End Sub

Private Sub Class_Terminate()
    Me.ClearFileNames
End Sub

'''''''''''''''''''''''''''''''
'Utility Routines
'''''''''''''''''''''''''''''''
Private Sub RaiseError(ByVal ErrValue As String)
'Extracts the value to be added to the vbObjectError
'constant from the 1st section of ErrValue, and
'the error description from the 2nd section
'(Sections delimited with ';')
'Appends the last internet response string

    Dim ptr As Integer
    Dim InetErr As Long
    '
    'If we have a session handle, destroy the session
    If m_hCon <> 0 Or m_hFTP <> 0 Then Me.CloseFTP
    '
    ptr = InStr(1, ErrValue, ";")
    InetErr = Err.LastDllError
    Err.Raise vbObjectError + Val(Left$(ErrValue, ptr - 1)), _
              "FTP Class", _
              Mid$(ErrValue, ptr + 1) & ". (OS error code = " & InetErr & ")" & _
              vbCrLf & "Internet Response: " & LastResponse(InetErr)
    
End Sub

Private Function LastResponse(ByVal ErrNum As Long) As String
'Obtains the last response string issued by server

    Dim Buffer As String
    Dim BufLen As Long
    '
    If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
        ErrNum = 0
        InternetGetLastResponseInfo ErrNum, vbNullString, BufLen
        Buffer = String(BufLen + 1, 0)
        InternetGetLastResponseInfo ErrNum, Buffer, BufLen
        LastResponse = Left(Buffer, BufLen)
    End If

End Function

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Uploading query results to a website 1

osp001

Technical User

eireanacht

Programmer

Similar threads

Part and Inventory Search

Sponsor