View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default FIND method , versus FOR EACH ...

below is code which calls the win32 ftp dll from VBA. It should return
everything you are looking for.

' 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


"ytayta555" wrote:

A good day

I want to use FIND method instead my
old FOR EACH method in my code , I
think (and I have read) it will work faster .

Actually , my code look so :
......
With FromWks1
Set myRng1 = .Range("AT20:BW20")
End With
.........
For Each myCell In myRng1.Cells
If myCell.Value = True Then
With FromWks1
.Cells(myCell.Row, myCell.Column).AutoFill _
Destination:=.Range(.Cells(myCell.Row, myCell.Column), .Cells(44,
myCell.Column))
.Range("A1:N1").Copy
.Range(.Cells("1", myCell.Column), .Cells("14",
myCell.Column)).PasteSpecial , _
Paste:=xlPasteValues, _
Transpose:=True
........... another actions ...
End With
End If
Next myCell

Please very much to provide me this code ,
which shall use FIND method instead actually
method I use ; I need FIND to look only in my
range ( myRng1 = .Range("AT20:BW20") ).

Many thanks in advance !