- Joined
- Jun 8, 2009
- Messages
- 24
- Reaction score
- 0
Hello everyone!
I am trying to upload an Excel file to FTP. Here is the code that I use to download from the FTP. I have tried everything that I can think of to make it upload, but without success.
Thank you for any help!
************************************
Module 1
************************************
'Coded by [email protected]
'Purpose:
'Module:
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400 '
Const SYNCHRONIZE = &H100000
Dim host As String, user As String, pswd As String
Sub test()
Dim i%
Dim myFile(1) As String
ChDrive VBA.Split(ThisWorkbook.Path, ":")(0)
ChDir ThisWorkbook.Path
myFile(1) = "Report.txt"
host = "ftp.anywhere.com" 'URL or ip
user = "user" 'ID
pswd = "password" 'Password
Call fungGet(myFile)
End Sub
Function fungGet(FileName() As String)
Dim hProcess As Long
Dim aaa As String
Dim pid As Long, ExitEvent As Long
Dim okFlg As Long
'FTP commands
aaa = "open " & host & vbCrLf & _
"user " & user & vbCrLf & _
pswd & vbCrLf & _
"bin" & vbCrLf & _
"cd bussys/winnt/winnt-public" & vbCrLf & _
"mget " & FileName(1) & vbCrLf & _
"y" & vbCrLf & _
"y" & vbCrLf & _
"bye"
Open "getfile.txt" For Output As #1
Print #1, aaa
Close #1
Application.StatusBar = "Downloading..."
pid = Shell("cmd.exe /c ""ftp -n -s:getfile.txt >output.txt""", vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, pid)
ExitEvent = WaitForSingleObject(hProcess, 15000&)
Call CloseHandle(hProcess)
Application.StatusBar = False
delDoc "getfile.txt"
Open "output.txt" For Input As #1
Do
Input #1, aaa
If aaa = "226 Transfer complete." Then okFlg = okFlg + 1
Loop Until EOF(1)
Close #1
delDoc "output.txt"
If okFlg = 1 Then ' 1 = the number of files downloaded.
MsgBox "Finished!"
Else
MsgBox "Failed!"
End If
Workbooks.Open ActiveWorkbook.Path + "/Report.xls"
End Function
************************************
Module 2
************************************
Option Explicit
Private Const FO_DELETE = &H3
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Sub delDoc(thePath)
Dim S As SHFILEOPSTRUCT
With S
.wFunc = FO_DELETE
.pFrom = thePath
.fFlags = FOF_NOCONFIRMATION
End With
SHFileOperation S
End Sub
Thanks in advance!
Joe
P.S. I should add that I am very willing to work this out, so if you could at least point me in the right direction, it would be much appreciated. I tried changed "mget" to "mput", and changing the code around, but there must be something more to it than that.
I am trying to upload an Excel file to FTP. Here is the code that I use to download from the FTP. I have tried everything that I can think of to make it upload, but without success.
Thank you for any help!
************************************
Module 1
************************************
'Coded by [email protected]
'Purpose:
'Module:
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400 '
Const SYNCHRONIZE = &H100000
Dim host As String, user As String, pswd As String
Sub test()
Dim i%
Dim myFile(1) As String
ChDrive VBA.Split(ThisWorkbook.Path, ":")(0)
ChDir ThisWorkbook.Path
myFile(1) = "Report.txt"
host = "ftp.anywhere.com" 'URL or ip
user = "user" 'ID
pswd = "password" 'Password
Call fungGet(myFile)
End Sub
Function fungGet(FileName() As String)
Dim hProcess As Long
Dim aaa As String
Dim pid As Long, ExitEvent As Long
Dim okFlg As Long
'FTP commands
aaa = "open " & host & vbCrLf & _
"user " & user & vbCrLf & _
pswd & vbCrLf & _
"bin" & vbCrLf & _
"cd bussys/winnt/winnt-public" & vbCrLf & _
"mget " & FileName(1) & vbCrLf & _
"y" & vbCrLf & _
"y" & vbCrLf & _
"bye"
Open "getfile.txt" For Output As #1
Print #1, aaa
Close #1
Application.StatusBar = "Downloading..."
pid = Shell("cmd.exe /c ""ftp -n -s:getfile.txt >output.txt""", vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, pid)
ExitEvent = WaitForSingleObject(hProcess, 15000&)
Call CloseHandle(hProcess)
Application.StatusBar = False
delDoc "getfile.txt"
Open "output.txt" For Input As #1
Do
Input #1, aaa
If aaa = "226 Transfer complete." Then okFlg = okFlg + 1
Loop Until EOF(1)
Close #1
delDoc "output.txt"
If okFlg = 1 Then ' 1 = the number of files downloaded.
MsgBox "Finished!"
Else
MsgBox "Failed!"
End If
Workbooks.Open ActiveWorkbook.Path + "/Report.xls"
End Function
************************************
Module 2
************************************
Option Explicit
Private Const FO_DELETE = &H3
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Sub delDoc(thePath)
Dim S As SHFILEOPSTRUCT
With S
.wFunc = FO_DELETE
.pFrom = thePath
.fFlags = FOF_NOCONFIRMATION
End With
SHFileOperation S
End Sub
Thanks in advance!
Joe
P.S. I should add that I am very willing to work this out, so if you could at least point me in the right direction, it would be much appreciated. I tried changed "mget" to "mput", and changing the code around, but there must be something more to it than that.
Last edited: