Option Compare Database
' Constants - InternetOpen.lAccessType
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0&
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1&
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3&
Public Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY As Long = 4&
' Constants - InternetOpen.dwFlags
Public Const INTERNET_FLAG_ASYNC As Long = &H10000000
Public Const INTERNET_FLAG_FROM_CACHE As Long = &H1000000
Public Const INTERNET_FLAG_OFFLINE As Long = INTERNET_FLAG_FROM_CACHE
' Constants - InternetConnect.nServerPort
Public Const INTERNET_INVALID_PORT_NUMBER As Long = 0&
Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21&
Public Const INTERNET_DEFAULT_GOPHER_PORT As Long = 70&
Public Const INTERNET_DEFAULT_HTTP_PORT As Long = 80&
Public Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443&
Public Const INTERNET_DEFAULT_SOCKS_PORT As Long = 1080&
' Constants - InternetConnect.dwService
Public Const INTERNET_SERVICE_FTP As Long = 1&
Public Const INTERNET_SERVICE_GOPHER As Long = 2&
Public Const INTERNET_SERVICE_HTTP As Long = 3&
' Constants - InternetConnect.dwFlags
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000
' Constants - FtpGetFile.dwFlags (FTP TransferType)
' Constants - FtpPutFile.dwFlags (FTP TransferType)
Public Const FTP_TRANSFER_TYPE_UNKNOWN As Long = &H0&
Public Const FTP_TRANSFER_TYPE_ASCII As Long = &H1&
Public Const FTP_TRANSFER_TYPE_BINARY As Long = &H2&
Public Const INTERNET_FLAG_TRANSFER_ASCII As Long = FTP_TRANSFER_TYPE_ASCII
Public Const INTERNET_FLAG_TRANSFER_BINARY As Long = FTP_TRANSFER_TYPE_BINARY
' Constants - FtpGetFile.dwFlags (Cache Flags)
' Constants - FtpPutFile.dwFlags (Cache Flags)
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800
Public Const INTERNET_FLAG_NEED_FILE As Long = &H10
Public Const INTERNET_FLAG_HYPERLINK As Long = &H400
' Constants - FtpGetFile.dwFlagsAndAttributes
Public Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Public Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Public Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Public Const FILE_ATTRIBUTE_READONLY As Long = &H1
Public Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Public Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
' FILETIME 構造体
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
' WIN32_FIND_DATA 構造体
Public Const MAX_PATH = 260
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
Type SystemTime
Year As Integer
Month As Integer
DayOfWeek As Integer
Day As Integer
Hour As Integer
Minute As Integer
Second As Integer
Milliseconds As Integer
End Type
Declare PtrSafe Function FileTimeToSystemTime Lib "KERNEL32.DLL" (ByRef lpFileTime As FileTime, ByRef lpSystemTime As SystemTime) As Long
' インターネットハンドルを取得します。
Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As LongPtr
' サーバへ接続します。
Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal HINTERNET As LongPtr, ByVal lpszServerName As String, ByVal nServerPort As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As LongPtr) As LongPtr
' インターネットハンドルを閉じます。
Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal HINTERNET As LongPtr) As Integer
' サーバのカレントディレクトリを取得します。
Declare PtrSafe Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hConnect As LongPtr, ByVal lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean
' サーバのカレントディレクトリを設定します。
Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hConnect As LongPtr, ByVal lpszDirectory As String) As Long
' サーバからファイルを取得します。
Declare PtrSafe Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As LongPtr, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As LongPtr) As Long
' サーバへファイルを転送します。
Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As LongPtr, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As LongPtr) As Long
' サーバのファイルを削除します。
Declare PtrSafe Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hConnect As LongPtr, ByVal lpszFileName As String) As Long
' サーバのファイル名を変更します。
Declare PtrSafe Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hConnect As LongPtr, ByVal lpszExisting As String, ByVal lpszNew As String) As Long
' サーバのディレクトリを削除します。
Declare PtrSafe Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hConnect As LongPtr, ByVal lpszDirectory As String) As Long
' 指定されたディレクトリを検索します。
Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As LongPtr, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As LongPtr) As LongPtr
' 引き続き、ディレクトリを検索します。
Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As LongPtr, lpvFindData As WIN32_FIND_DATA) As Long
'********************************************************
'* WinInetを使ったFTP処理の考え方
'*
'* 1 Internet Open (インターネットサービスのハンドル取得)
'* 2 OKなら InternetConnect(FTPサーバーへ接続)
'* 3 OKなら カレントディレクトリ変更
'* 4 OKなら、メイン処理
'* -----------------------------------------------------
'* このため、エラーコードの XYYYYY の
'* Xの値が上記のStep No
'* YYYYYがWinInetのエラーコード となるようにした
'* これでどこまでうまくいっているのかがすぐにわかるように
'*********************************************************
Const User_Agent = "FTP_VBA"
Function saPutFTP(FTP_Server, UID, PWD, Folder, FileName, Optional DestName) As Long
'*************************************************************************
'* FTP File Put (Upload) Send by BINARY
'*************************************************************************
' Folder : Directory on FTP Server
' FileName: Local File FullPath (Separated by |)
' DestName: FileName (optional Separated by | )
'
' ・FileName,DestNameは、|をセパレータとして複数指定できます
' ・DestNameがないときは、送信元ファイル名がそのまま使われます
' ・送信元ファイル名にワイルドカード(*/?が)が使われた時は、
' DestNameは無視して送信元ファイル名を使用します
' ・FileNameとDestNameのsplit後の数が同じでないときは、エラー499999
'-------------------------------------------------------------------------'
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
'------------------------------------------------ Upload Main ----------------
Dim wDestName As String
Dim FF() As String
Dim TT() As String
FF = Split(FileName, "|")
If IsMissing(DestName) Then wDestName = "" Else wDestName = DestName
If InStr(FileName, "*") <> 0 Or InStr(FileName, "?") <> 0 Then wDestName = ""
If wDestName <> "" Then
TT = Split(wDestName, "|")
If UBound(FF) <> UBound(TT) Then
saPutFTP = 499999
Exit Function
End If
End If
Dim i As Long
For i = 0 To UBound(FF)
If wDestName = "" Then
If InStr(FF(i), "*") <> 0 Or InStr(FF(i), "?") <> 0 Then
Dim wFF
wFF = Dir(FF(i), 0)
Do While wFF <> ""
Result = FtpPutFile(hConnection, Left(FF(i), InStrRev(FF(i), "\")) & wFF, wFF, FTP_TRANSFER_TYPE_BINARY, 0)
wFF = Dir()
Loop
Else
Result = FtpPutFile(hConnection, FF(i), Mid(FF(i), InStrRev(FF(i), "\") + 1), FTP_TRANSFER_TYPE_BINARY, 0)
End If
Else
Result = FtpPutFile(hConnection, FF(i), TT(i), FTP_TRANSFER_TYPE_BINARY, 0)
End If
If (Result = 0) Then
saPutFTP = i * 1000000 + 400000 + Err.LastDllError
Else
saPutFTP = 0
End If
Next
'------------------------------------------------ Upload Main End ------------
Else
saPutFTP = 300000 + Err.LastDllError
End If
Else
saPutFTP = 200000 + Err.LastDllError
End If
Else
saPutFTP = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
End Function
Function saGetFTP(FTP_Server, UID, PWD, Folder, FileName, DestName) As Long
'*********************************************************
'* FTP File Get (Download)
'*********************************************************
' Folder : Directory on FTP Server
' FileName: FileName (Separated by | )
' DestName: Local File FullPath (Separated by |)
' フォルダのみ指定の場合はファイル名は同一(最後が\)
' DestNameのsplit後の数が少ないときは、最後のフォルダ指定を使用して、同じファイル名でDL
'
' ・FileName,DestNameは、|をセパレータとして複数指定できます
' ・DestNameがないときは、送信元ファイル名がそのまま使われます
' ・送信元ファイル名にワイルドカード(*/?が)が使われた時は、
' DestNameは無視して送信元ファイル名を使用します
' ・split後の数がFileName < DestNameのときは、エラー499999
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
Dim w32FindData As WIN32_FIND_DATA
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
'------------------------------------------------ Download Main ----------------
Dim wDestName As String
Dim wDestFol As String
Dim FF() As String
Dim TT() As String
FF = Split(FileName, "|")
TT = Split(DestName, "|")
If UBound(FF) < UBound(TT) Then
saGetFTP = 499999
Exit Function
End If
Dim i As Long
For i = 0 To UBound(FF)
If UBound(TT) >= i Then ' ttの指定があり、フォルダの指定があるなら、DL先フォルダを取得 なければ最後のDL先フォルダを使用する
If InStr(TT(i), "\") <> 0 Then wDestFol = Left(TT(i), InStrRev(TT(i), "\"))
End If
If InStr(FF(i), "*") <> 0 Or InStr(FF(i), "?") <> 0 Then '-------------------- Wildcard? ----
saGetFTP = 0
hFind = FtpFindFirstFile(hConnection, FF(i), w32FindData, INTERNET_FLAG_RELOAD, 0)
If (hFind = 0) Then
RtnCD = 400000 + Err.LastDllError
Else
Do
strFile = Left(w32FindData.cFileName, InStr(w32FindData.cFileName, vbNullChar) - 1)
'strFile = Mid(strFile, InStrRev(strFile, " ") + 1) '
If ((w32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = &H10) Then
' it is Folder
Else
wDestName = strFile '元のファイル名
Result = FtpGetFile(hConnection, strFile, wDestFol & "\" & wDestName, False, _
FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, 0)
If (Result = 0) Then
saGetFTP = i * 1000000 + 400000 + Err.LastDllError
End If
End If
Loop Until InternetFindNextFile(hFind, w32FindData) = 0
End If
Else '--------------------------------------------------------------------- Not Wildcard ----
If UBound(TT) >= i Then ' ttの指定があり、
If Right(TT(i), 1) = "\" Then 'フォルダ指定のみ
wDestName = FF(i)
Else
If InStr(TT(i), "\") <> 0 Then 'フォルダ+ファイル指定?
wDestName = Mid(TT(i), InStrRev(TT(i), "\") + 1)
Else 'ファイル指定のみ
wDestName = TT(i)
End If
End If
Else ' ttの指定なし
wDestName = FF(i)
End If
Result = FtpGetFile(hConnection, FF(i), wDestFol & "\" & wDestName, False, _
FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, 0)
If (Result = 0) Then
saGetFTP = i * 1000000 + 400000 + Err.LastDllError
Else
saGetFTP = 0
End If
End If
Next
'------------------------------------------------ Download Main End ------------
Else
saGetFTP = 300000 + Err.LastDllError
End If
Else
saGetFTP = 200000 + Err.LastDllError
End If
Else
saGetFTP = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
End Function
Function saDelFTP(FTP_Server, UID, PWD, Folder, FileName) As Long
'*********************************************************
'* FTP File Delete
'*********************************************************
'Folder: Directory on FTP Server
'FileName: FileName (Separated by |)
' and can use wildcard */?
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
Dim w32FindData As WIN32_FIND_DATA
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
'------------------------------------------------ Delete Main ----------------
Dim FF() As String
FF = Split(FileName, "|")
Dim i As Long
For i = 0 To UBound(FF)
If InStr(FF(i), "*") <> 0 Or InStr(FF(i), "?") <> 0 Then '-------------------- Wildcard? ----
saDelFTP = 0
hFind = FtpFindFirstFile(hConnection, FF(i), w32FindData, INTERNET_FLAG_RELOAD, 0)
If (hFind = 0) Then
RtnCD = 400000 + Err.LastDllError
Else
Do
strFile = Left(w32FindData.cFileName, InStr(w32FindData.cFileName, vbNullChar) - 1)
If ((w32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = &H10) Then
'
Else
Result = FtpDeleteFile(hConnection, strFile)
If (Result = 0) Then
saDelFTP = 400000 + Err.LastDllError
End If
End If
Loop Until InternetFindNextFile(hFind, w32FindData) = 0
End If
Else '--------------------------------------------------------------------- Not Wildcard ----
Result = FtpDeleteFile(hConnection, FF(i))
If (Result = 0) Then
saDelFTP = 400000 + Err.LastDllError
Else
saDelFTP = 0
End If
End If
Next
'------------------------------------------------ Delete Main End ------------
Else
saDelFTP = 300000 + Err.LastDllError
End If
Else
saDelFTP = 200000 + Err.LastDllError
End If
Else
saDelFTP = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
End Function
Function saRenFTP(FTP_Server, UID, PWD, Folder, FileName, NewName) As Long
'*********************************************************
'* FTP File Rename
'*********************************************************
'Folder: Directory on FTP Server
'FileName: TargetFileName (Separated by |)
'NewName: NewFileName (Separated by |)
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
'------------------------------------------------ Rename Main ----------------
saRenFTP = 0
Dim FF() As String
Dim TT() As String
FF = Split(FileName, "|")
TT = Split(NewName, "|")
If UBound(FF) <> UBound(TT) Then
saRenFTP = 499999
Exit Function
End If
Dim i As Long
For i = 0 To UBound(FF)
Result = FtpRenameFile(hConnection, FF(i), TT(i))
If (Result = 0) Then
saRenFTP = i * 1000000 + 400000 + Err.LastDllError
End If
Next
'------------------------------------------------ Rename Main End ------------
Else
saRenFTP = 300000 + Err.LastDllError
End If
Else
saRenFTP = 200000 + Err.LastDllError
End If
Else
saRenFTP = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
End Function
Function saRemDirFTP(FTP_Server, UID, PWD, Folder, DelFolder) As Long
'*********************************************************
'* FTP Remove Directory 1 Layer Only
'* Delete [FolderName] Directory on [Folder] Directory
'* Delete when Directory is empty
'*********************************************************
'Folder: Directory on FTP Server
'FolderName: Remove Folder Name
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
Result = FtpRemoveDirectory(hConnection, DelFolder)
If (Result = 0) Then
saRemDirFTP = 400000 + Err.LastDllError
Else
saRemDirFTP = 0
End If
Else
saRemDirFTP = 300000 + Err.LastDllError
End If
Else
saRemDirFTP = 200000 + Err.LastDllError
End If
Else
saRemDirFTP = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
End Function
Function saGetListFTP(FTP_Server, UID, PWD, Folder, Search, ByRef FileList() As String)
'*********************************************************
'* FTP Get File List
'* Search: "*.*" など
'* Return: FileList Table(File/Folder Name Only - NoPath)
'* Folder Nameのとき、最後に/(Slash)がつきます
'*********************************************************
'Folder: Directory on FTP Server
Dim hOpen As LongPtr
Dim hConnection As LongPtr
Dim Result As Long
Dim w32FindData As WIN32_FIND_DATA
Dim wSystemTime As SystemTime
Dim wCreateDT As String
hOpen = 0
hConnection = 0
hOpen = InternetOpen(User_Agent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If (hOpen <> 0) Then
hConnection = InternetConnect(hOpen, FTP_Server, INTERNET_INVALID_PORT_NUMBER, _
UID, PWD, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If (hConnection <> 0) Then
Result = FtpSetCurrentDirectory(hConnection, Folder)
If (Result <> 0) Then
hFind = FtpFindFirstFile(hConnection, Search, w32FindData, INTERNET_FLAG_RELOAD, 0)
If (hFind = 0) Then
RtnCD = 400000 + Err.LastDllError
Else
'Dim FileList() As String
Dim Cnt As Long, i As Long
Cnt = -1
Do
strFile = Left(w32FindData.cFileName, InStr(w32FindData.cFileName, vbNullChar) - 1)
'strFile = Mid(strFile, InStrRev(strFile, " ") + 1) '
If ((w32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = &H10) Then
strFile = strFile & "/" 'Add / when it is Folder
End If
'Caution!!!! FTPサーバーによっては、日付を返さなかったりすることもあるので注意!
'この処理も、2003では、最終更新日しか返してもらえなかったのでこれを使用しているだけ
Call FileTimeToSystemTime(w32FindData.ftLastWriteTime, wSystemTime)
With wSystemTime
wCreateDT = .Year & "/" & Format(.Month, "00") & "/" & Format(.Day, "00") & " " & Format(.Hour, "00") & ":" & Format(.Minute, "00") & ":" & Format(.Second, "00")
End With
Cnt = Cnt + 1
ReDim Preserve FileList(Cnt)
FileList(Cnt) = wCreateDT & "\" & strFile ' 日付を先にしてあるので、あとで日付順にソートできる
Loop Until InternetFindNextFile(hFind, w32FindData) = 0
End If
'saGetListFTP = FileList
RtnCD = 0
Else
RtnCD = 300000 + Err.LastDllError
End If
Else
RtnCD = 200000 + Err.LastDllError
End If
Else
RtnCD = 100000 + Err.LastDllError
End If
If (hConnection <> 0) Then InternetCloseHandle hConnection
If (hOpen <> 0) Then InternetCloseHandle hOpen
saGetListFTP = RtnCD
End Function
■■■ 送信 (saPutFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Target File、(option: Destination Name) 送信ファイル名とアップロードのファイル名を変更したいときに第6パラメータを設定してください - Target File, Destinatioin Nameは、|をセパレータとして複数指定できます - Destinatioin Nameがないときは、送信元ファイル名がそのまま使われます - 送信元ファイル名にワイルドカード(*/?が)が使われた時は、 Destinatioin Nameは無視して送信元ファイル名を使用します - Target FileとDestinatioin Nameのsplit後の数が同じでないときは、エラー499999 ・リターンコード(long)にエラーコードが返ります
《サンプル》 ・r = saPutFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "\\Local_Web_Server\Web\SITE\DB.accdb","Web.accdb") ・r = saPutFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "Z:\*.aspx")
■■■ 受信 (saGetFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Target File、Destination Name - Target File, Destinatioin Nameは、|をセパレータとして複数指定できます - Destinatioin Nameがフォルダ名のみのときは、送信元ファイル名がそのまま使われます - 送信元ファイル名にワイルドカード(*/?が)が使われた時は、 Destinatioin Nameは無視して送信元ファイル名を使用します - Target FileとDestinatioin Nameのsplit後の数が同じでないときは、エラー499999 ・リターンコード(long)にエラーコードが返ります
《サンプル》 r = saGetFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "*.mdb","z:\test\")
■■■ ファイル削除 (saDelFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Target File - Target Fileは、|をセパレータとして複数指定できます - Target Fileにワイルドカード(*/?が)が使用可能です ・リターンコード(long)にエラーコードが返ります
《サンプル》 r = saDelFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "*.mdb")
■■■ ファイル名変更 (saRenFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Target File、New Name - Target File、New Nameは、|をセパレータとして複数指定できます ・リターンコード(long)にエラーコードが返ります
《サンプル》 r = saRenFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "A.mda","A.mdb")
■■■ フォルダ削除 (saRemDirFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Target Folder ・リターンコード(long)にエラーコードが返ります
《サンプル》 r = saRemDirFTP("ftp.your-domain.com.au", "UserID", "password", "/wwwroot", "DB")
■■■ ファイル一覧 (saGetListFTP) ■■■ 《引数》 ・Host Name、UserID、password、Host Folder、Searchコマンド、配列 ・配列には、日付 + ”\” + ファイル名 フォルダの場合は、最後に"/"が付加されます ・リターンコード(long)にエラーコードが返ります
《サンプル》 Dim a() As String r = saGetListFTP("192.168.0.172", "regi", "Creqagah0", "/Work", "*.*", a) If r = 0 Then For i = 0 To UBound(a) Debug.Print a(i) Next Else Debug.Print r End If
【その他】 ・WinInetのエラーコード一覧はこちら https://support.microsoft.com/ja-jp/help/193625/info-wininet-error-codes-12001-through-12156
【特記事項】 ・IISでのみテストを行っています
|