makro ile ftp yapmak

Hüseyin

Administrator
Yönetici
Admin
Katılım
2 Haziran 2004
Mesajlar
3,541
Excel Vers. ve Dili
Excel 2010 - Türkçe
Merhaba,
aşağıdaki kodlar
www.xcelfiles.com
dan alınmıştır.
Sizin kullanabilmeniz için değiştirmeniz gereken parametreleri unutmayın.
(Adres, Kullanıcı adı, Þifre ve sonradan kullanılan dosya ve dizin isimleri)

Ã?rnekte
1- Yeni dizin yaratılmış
2- Bu dizine bir dosya gönderilmiş
3- Gönderilen dosyanın ismi değiştirilmiş
4- Yeni isimdeki dosya yine ftp ile lokal pc ye indirilmiş oluyor.
5- Oluşturulan Dizin ve dosya karşı serverden siliniyor.

Siz bunlardan ihtiyacınız olanı ayıklayabilirsiniz.

Kodları ben denemedim.
Deneme sonuçlarını paylaşırsanız memnun olurum.





Kod:
Option Explicit
'//
'// Dedicated to my Friend Colo
'// Some of the code from http://www.allapi.net
'// spec thanks to Joacim Andersson 29 July 2001
'// Amendments by Ivan F Moala 28 Sept 2002
'//

Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_PASSIVE = &H8000000      '// used for FTP connections
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0       '// use registry configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1          '// direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3           '// via named proxy
Private Const _
   INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 '// prevent using java/script/INS
Private Const MAX_PATH = 260

Private Const INTERNET_INVALID_PORT_NUMBER = 0   '// use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21     '// default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70  '//    "     "  gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80    '//    "     "  HTTP   "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443  '//    "     "  HTTPS  "
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080 '// default for SOCKS firewall servers.

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 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 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
   
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
   Alias "FtpSetCurrentDirectoryA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszDirectory As String) As Boolean
   
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" _
   Alias "FtpGetCurrentDirectoryA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszCurrentDirectory As String, _
   lpdwCurrentDirectory As Long) As Long
   
Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
   Alias "FtpCreateDirectoryA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszDirectory As String) As Boolean
   
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" _
   Alias "FtpRemoveDirectoryA" ( _
   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 FtpRenameFile Lib "wininet.dll" _
   Alias "FtpRenameFileA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszExisting As String, _
   ByVal lpszNew As String) As Boolean
   
Private Declare Function FtpGetFile Lib "wininet.dll" _
   Alias "FtpGetFileA" ( _
   ByVal hConnect As Long, _
   ByVal lpszRemoteFile As String, _
   ByVal lpszNewFile As String, _
   ByVal fFailIfExists As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal dwFlags As Long, _
   ByRef dwContext As Long) As Boolean
   
Private Declare Function FtpPutFile Lib "wininet.dll" _
   Alias "FtpPutFileA" ( _
   ByVal hConnect As Long, _
   ByVal lpszLocalFile As String, _
   ByVal lpszNewRemoteFile As String, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long) As Boolean
   
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
   Alias "InternetGetLastResponseInfoA" ( _
   lpdwError As Long, _
   ByVal lpszBuffer As String, _
   lpdwBufferLength As Long) 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 InternetFindNextFile Lib "wininet.dll" _
   Alias "InternetFindNextFileA" ( _
   ByVal hFind As Long, _
   lpvFindData As WIN32_FIND_DATA) As Long
   
Private Const PassiveConnection As Boolean = True
Private Const FtpServer As String = "ftp.census.gov/pub/"  '//Değiştir
Private Const ERROR_NO_MORE_FILES = 18&

'// Logon constants
Private Const strLogon As String = "anonymous"  '//Değiştir
Private Const strPwd As String = "guest"  '//Değiştir

'// Some ftp sites to test
'// You will need your OWN Ftp Site
'// To Test this on as you will be
'// Creating / deleting Dir
'//

Sub Ftp_Test()
    Dim hConnection As Long, hOpen As Long, sOrgPath  As String
    '// open an internet connection
    hOpen = InternetOpen("Colo Example", _
                         INTERNET_OPEN_TYPE_PRECONFIG, _
                         vbNullString, _
                         vbNullString, _
                         0)
    '// connect to the FTP server
    hConnection = InternetConnect(hOpen, _
                                 FtpServer, _
                                 INTERNET_DEFAULT_FTP_PORT, _
                                 strLogon, _
                                 strPwd, _
                                 INTERNET_SERVICE_FTP, _
                                 IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), _
                                 0)
    '// create a buffer to store the original directory
    sOrgPath = String(MAX_PATH, 0)
    '// get the directory
    FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
    '// create a new directory 'testing'
    FtpCreateDirectory hConnection, "testing"
    '// set the current directory to 'root/testing'
    FtpSetCurrentDirectory hConnection, "testing"
    '// upload the file 'README.htm'
    FtpPutFile hConnection, "C:\README.htm", "README.htm", FTP_TRANSFER_TYPE_UNKNOWN, 0
    '// rename 'README.htm' to 'Colo.htm'
    FtpRenameFile hConnection, "README.htm", "Colo.htm"
    '// enumerate the file list from the current directory ('root/testing')
    EnumFiles hConnection
    '// retrieve the file from the FTP server
    FtpGetFile hConnection, "Colo.htm", _
                            "c:\Colo.htm", _
                            False, _
                            0, _
                            FTP_TRANSFER_TYPE_UNKNOWN, _
                            0
    '// delete the file from the FTP server
    FtpDeleteFile hConnection, "Colo.htm"
    '// set the current directory back to the root
    FtpSetCurrentDirectory hConnection, sOrgPath
    '// remove the direcrtory 'testing'
    FtpRemoveDirectory hConnection, "testing"
    '// close the FTP connection
    InternetCloseHandle hConnection
    '// close the internet connection
    InternetCloseHandle hOpen
End Sub

Public Sub EnumFiles(hConnection As Long)
    Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
    '// 
    '//
    '// create a buffer
    pData.cFileName = String(MAX_PATH, 0)
    '// find the first file
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
    '// if there's no file, then exit sub
    If hFind = 0 Then Exit Sub
    '// show the filename
    MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
      String(1, 0), vbBinaryCompare) - 1)
    Do
        '// create a buffer
        pData.cFileName = String(MAX_PATH, 0)
        '// find the next file
        lRet = InternetFindNextFile(hFind, pData)
        '// if there's no next file, exit do
        If lRet = 0 Then Exit Do
        '// show the filename
        MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
         String(1, 0), vbBinaryCompare) - 1)
    Loop
    '// close the search handle
    InternetCloseHandle hFind
End Sub

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 "Error " & CStr(lErr) & ": " & sErr, vbOKOnly + vbCritical
End Sub
 
Üst