Hi all,
I'm new with excel programming.
I'm using Excel 2003.
I would like to create a TCP socket client in my VBA application;
I think I need a reference to WinSock dll, but when I trie to add it
through the
Tools-Reference menu I always receive an error message.

Could anyone help me, please?

Thanks in advance

You don't add references when using DLL's. Instead you define the call for
the DLL function in excel like the code below. Depending on the function you
may or not need the alias portion of the library definiation. Some entry
point to functions require an Alias and some don't. If you get an error
mesage that it can't find the function then either add the A (Alias) or
remove it. the Library definition sstatement goes before your SUB definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE, IIf(sMode =
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName &
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path and
Filename of local file", "Target Filename without path", "Directory on FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub


"faffo1980" wrote:

Hi all,
I'm new with excel programming.
I'm using Excel 2003.
I would like to create a TCP socket client in my VBA application;
I think I need a reference to WinSock dll, but when I trie to add it
through the
Tools-Reference menu I always receive an error message.

Could anyone help me, please?

Thanks in advance

Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the call for
the DLL function in excel like the code below. Depending on the function you
may or not need the alias portion of the library definiation. Some entry
point to functions require an Alias and some don't. If you get an error
mesage that it can't find the function then either add the A (Alias) or
remove it. the Library definition sstatement goes before your SUB definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE, IIf(sMode =
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName &
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path and
Filename of local file", "Target Filename without path", "Directory on FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub


"faffo1980" wrote:

Hi all,
I'm new with excel programming.
I'm using Excel 2003.
I would like to create a TCP socket client in my VBA application;
I think I need a reference to WinSock dll, but when I trie to add it
through the
Tools-Reference menu I always receive an error message.

Could anyone help me, please?

Thanks in advance

Two possible ways

The SHELL function returns the Process ID

You can get the Process ID number from the name of the window

AppActivate title[, wait]



"faffo1980" wrote:

Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the call for
the DLL function in excel like the code below. Depending on the function you
may or not need the alias portion of the library definiation. Some entry
point to functions require an Alias and some don't. If you get an error
mesage that it can't find the function then either add the A (Alias) or
remove it. the Library definition sstatement goes before your SUB definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE, IIf(sMode =
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName &
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path and
Filename of local file", "Target Filename without path", "Directory on FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub


"faffo1980" wrote:

Hi all,
I'm new with excel programming.
I'm using Excel 2003.
I would like to create a TCP socket client in my VBA application;
I think I need a reference to WinSock dll, but when I trie to add it
through the
Tools-Reference menu I always receive an error message.

Could anyone help me, please?

Thanks in advance

You can add the winsock control to a form or worksheet. First you'll need to
add it to the toolbox, rt-click, additional controls, check Microsoft
Winsock Control.

From memory this might be one of the controls that needs an additional
update to avoid security issues in later OS.

Again from memory, there might be some problems if using the control on a
worksheet, don't recall quite what but something that came up in this ng a
while ago.

Regards,
Peter T


"faffo1980" wrote in message
...
Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the call
for
the DLL function in excel like the code below. Depending on the function
you
may or not need the alias portion of the library definiation. Some entry
point to functions require an Alias and some don't. If you get an error
mesage that it can't find the function then either add the A (Alias) or
remove it. the Library definition sstatement goes before your SUB
definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As
Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE, IIf(sMode
=
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName &
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0
Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path and
Filename of local file", "Target Filename without path", "Directory on
FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub


"faffo1980" wrote:

Hi all,
I'm new with excel programming.
I'm using Excel 2003.
I would like to create a TCP socket client in my VBA application;
I think I need a reference to WinSock dll, but when I trie to add it
through the
Tools-Reference menu I always receive an error message.

Could anyone help me, please?

Thanks in advance

Thanks Peter,
I'm not lucky...in my installation winsock Control doesn't exist.
I'm not able to find it in the additional available control list.

faffo1980

"Peter T" wrote:

You can add the winsock control to a form or worksheet. First you'll need to
add it to the toolbox, rt-click, additional controls, check Microsoft
Winsock Control.

From memory this might be one of the controls that needs an additional
update to avoid security issues in later OS.

Again from memory, there might be some problems if using the control on a
worksheet, don't recall quite what but something that came up in this ng a
while ago.

Regards,
Peter T


"faffo1980" wrote in message
...
Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the call
for
the DLL function in excel like the code below. Depending on the function
you
may or not need the alias portion of the library definiation. Some entry
point to functions require an Alias and some don't. If you get an error
mesage that it can't find the function then either add the A (Alias) or
remove it. the Library definition sstatement goes before your SUB
definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As
Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE, IIf(sMode
=
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName &
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0
Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path and
Filename of local file", "Target Filename without path", "Directory on
FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub

Do you have "mswinsck.ocx", probably in your system32 folder. If not I guess
it's a control supplied with VB6.

Thinking again, a more useful control for you might be the MSComm
Tools, refs, Microsoft Comm Control (if necessary browse to mscomm32.ocx in
system32)
then add the control to the toolbox
Microsoft Communications Control

Don't ask me how to use it. That said, I helped someone with this control
once in this ng, however for some reason I can no longer search this group
with google for anything more than a few months old.

Regards,
Peter T

"faffo1980" wrote in message
...
Thanks Peter,
I'm not lucky...in my installation winsock Control doesn't exist.
I'm not able to find it in the additional available control list.

faffo1980

"Peter T" wrote:

You can add the winsock control to a form or worksheet. First you'll need
to
add it to the toolbox, rt-click, additional controls, check Microsoft
Winsock Control.

From memory this might be one of the controls that needs an additional
update to avoid security issues in later OS.

Again from memory, there might be some problems if using the control on a
worksheet, don't recall quite what but something that came up in this ng
a
while ago.

Regards,
Peter T


"faffo1980" wrote in message
...
Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the
call
for
the DLL function in excel like the code below. Depending on the
function
you
may or not need the alias portion of the library definiation. Some
entry
point to functions require an Alias and some don't. If you get an
error
mesage that it can't find the function then either add the A (Alias)
or
remove it. the Library definition sstatement goes before your SUB
definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As
Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As
Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As
Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes
uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE
(100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName,
INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE,
IIf(sMode
=
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName
&
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) =
0
Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))


' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName,
INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)


Folder = FtpGetCurrentDirectory(hConnection, _
lpszCurrentDirectory, lpdwCurrentDirectory)
End Function
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'create a buffer
sErr = String(lenBuf, 0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'show the last response info
MsgBox "Last Server Response : " + sErr, vbOKOnly + vbCritical
End Sub

Sub FTP()

' Upload file
If FTPFile("ftp.domain.com", "myUserName", "myPassword", "Full path
and
Filename of local file", "Target Filename without path", "Directory on
FTP
server", "Upload Mode - Binary or ASCII") Then
MsgBox "Upload - Complete!"
End If
End Sub
Sub test_GetDirectory()
HostName = "ftp.microsoft.com"
User = "FTP"
PassWd = "
Folder = ""

Call FTPGetDir(HostName, _
User, _
PassWd, _
Folder)

End Sub

I do have the mswinsck.ocx, as I have VB6 installed. I also have the Winsock
in my "com controls" list but as soon as I try to add the winsock control I
get en error stating that it's not trusted. This also happens to the mscomm
control whereas I have no trouble loading the webbrowser control.

Peter T mentioned that the winsock control might be one of the controls that
need an extra update to avoid security issues in later OS. Could you perhpas
tell me where I can get such an update if this is indeed the problem (before
SP3 XPP I never experianced problems using the winsock control in Excel)

Many thanks,

Peter V.

"Peter T" wrote:

Do you have "mswinsck.ocx", probably in your system32 folder. If not I guess
it's a control supplied with VB6.

Thinking again, a more useful control for you might be the MSComm
Tools, refs, Microsoft Comm Control (if necessary browse to mscomm32.ocx in
system32)
then add the control to the toolbox
Microsoft Communications Control

Don't ask me how to use it. That said, I helped someone with this control
once in this ng, however for some reason I can no longer search this group
with google for anything more than a few months old.

Regards,
Peter T

"faffo1980" wrote in message
...
Thanks Peter,
I'm not lucky...in my installation winsock Control doesn't exist.
I'm not able to find it in the additional available control list.

faffo1980

"Peter T" wrote:

You can add the winsock control to a form or worksheet. First you'll need
to
add it to the toolbox, rt-click, additional controls, check Microsoft
Winsock Control.

From memory this might be one of the controls that needs an additional
update to avoid security issues in later OS.

Again from memory, there might be some problems if using the control on a
worksheet, don't recall quite what but something that came up in this ng
a
while ago.

Regards,
Peter T


"faffo1980" wrote in message
...
Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the
call
for
the DLL function in excel like the code below. Depending on the
function
you
may or not need the alias portion of the library definiation. Some
entry
point to functions require an Alias and some don't. If you get an
error
mesage that it can't find the function then either add the A (Alias)
or
remove it. the Library definition sstatement goes before your SUB
definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As
Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As
Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As
Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes
uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE
(100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName,
INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE,
IIf(sMode
=
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" & RemoteFileName
&
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) =
0
Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String, _
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))

I vaguely recall reading there's an updated winsock control that avoids the
security problem, in a quick search I can't find it so perhaps I was
confusing with some other control. Failing that there's a registry hack

http://support.microsoft.com/kb/827742

Regards,
Peter T

"Peter Vroegindewey" <Peter wrote in
message ...
I do have the mswinsck.ocx, as I have VB6 installed. I also have the
Winsock
in my "com controls" list but as soon as I try to add the winsock control
I
get en error stating that it's not trusted. This also happens to the
mscomm
control whereas I have no trouble loading the webbrowser control.

Peter T mentioned that the winsock control might be one of the controls
that
need an extra update to avoid security issues in later OS. Could you
perhpas
tell me where I can get such an update if this is indeed the problem
(before
SP3 XPP I never experianced problems using the winsock control in Excel)

Many thanks,

Peter V.

"Peter T" wrote:

Do you have "mswinsck.ocx", probably in your system32 folder. If not I
guess
it's a control supplied with VB6.

Thinking again, a more useful control for you might be the MSComm
Tools, refs, Microsoft Comm Control (if necessary browse to mscomm32.ocx
in
system32)
then add the control to the toolbox
Microsoft Communications Control

Don't ask me how to use it. That said, I helped someone with this control
once in this ng, however for some reason I can no longer search this
group
with google for anything more than a few months old.

Regards,
Peter T

"faffo1980" wrote in message
...
Thanks Peter,
I'm not lucky...in my installation winsock Control doesn't exist.
I'm not able to find it in the additional available control list.

faffo1980

"Peter T" wrote:

You can add the winsock control to a form or worksheet. First you'll
need
to
add it to the toolbox, rt-click, additional controls, check Microsoft
Winsock Control.

From memory this might be one of the controls that needs an additional
update to avoid security issues in later OS.

Again from memory, there might be some problems if using the control
on a
worksheet, don't recall quite what but something that came up in this
ng
a
while ago.

Regards,
Peter T


"faffo1980" wrote in message
...
Thanks Joel,
I will try your solution and let you know.
Is there a sinpler way to use socket in VBA?

Thanks

faffo1980

"Joel" wrote:

You don't add references when using DLL's. Instead you define the
call
for
the DLL function in excel like the code below. Depending on the
function
you
may or not need the alias portion of the library definiation. Some
entry
point to functions require an Alias and some don't. If you get an
error
mesage that it can't find the function then either add the A
(Alias)
or
remove it. the Library definition sstatement goes before your SUB
definition
line.


Set Constants
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const GENERIC_WRITE = &H40000000
Const BUFFER_SIZE = 100
Const PassiveConnection As Boolean = True
' Declare wininet.dll API Functions
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll"
Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As
Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll"
Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As
String,
lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite
As
Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As
Long,
ByVal Flags As Long, ByVal Context As Long) As Long

Public 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

Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public 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

Public 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


Public 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

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(ByRef lpdwError As Long, _
ByVal lpszErrorBuffer As String, _
ByRef lpdwErrorBufferLength As Long) As Boolean
Function FTPFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String) As Boolean

On Error GoTo Err_Function

' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes
uploaded
Dim iLoop As Long ' Loop for uploading chuncks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE
(100)
elements 0 to 99

' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)

' Connect to FTP
hConnection = InternetConnect(hOpen, HostName,
INTERNET_DEFAULT_FTP_PORT,
UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection,
INTERNET_FLAG_PASSIVE, 0), 0)

' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)

' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_WRITE,
IIf(sMode
=
"Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)

' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading File (" &
RemoteFileName
&
")", iSize / 1000)

' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) /
1000)

'Get file data
Get iFile, , FileData

' Write chunk to FTP checking for success
If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten)
=
0
Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Next iLoop

' Handle remainder using MOD

' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

' Get file data
Get iFile, , FileData

' Write remainder to FTP checking for success
If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE,
iWritten) = 0 Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
Else
' Check buffer was written
If iWritten < iSize Mod BUFFER_SIZE Then
MsgBox "Upload - Failed!"
ShowError
FTPFile = False
GoTo Exit_Function
End If
End If

Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & Err.Description
GoTo Exit_Function

End Function

Function FTPGetDir(ByVal HostName As String, ByVal User As String,
_
ByVal PassWd As String, ByVal Folder As String)

' Declare variables
Dim hConnection, hOpen As Long ' Used For Handles
Dim lpszCurrentDirectory As String
Dim lpdwCurrentDirectory As Long

lpszCurrentDirectory = "." & String(1023, Chr(0))