ajetrumpet
Banned
- Local time
- Today, 10:13
- Joined
- Jun 22, 2007
- Messages
- 5,638
i recently had the need to find this code, for a reason i never thought i would use it for, so i'm posting it here. it uses VBA to PUT (FTP) a file to a server...
here is an example i gave to someone who didn't know how to operate DOS, and needed to get files to me from a remote location...
<EDIT>
MY NEEDS FOR THIS THING now have expanded beyond my wildest expectations, but because the people I work for are not interested in buying the "GoToMyPC" thing, I guess we do this instead, through Access no less! Wow...talk about using programs for what they were NOT intended for.
At any rate, here is something that will give the user a chance to select as many folders as they want to upload to a server root directory. As the upload takes place and you see the DOS window on screen doing it's magic, there is a box that pops up on top of that even that says something "Wait until it's done, then press OK". (it wont work this way for others, because my popup for is customize with plenty of code. but in general, here's the IDEA:
ANOTHER EXAMPLE
Here's a substitute for buying an FTP program that I wrote for , to upload, download and delete files from there personal directories on the server. Below is the upload code and download code I used. Quite simple really...(uses DOS FTP):
I have attached an FTP application that can be used on any local machine. It connect to remote servers if you put the right data into it! I suppose this is a bit too much to post on here, but it is actually a pretty good program I wrote. Whoever uses it, Enjoy!
Code:
function FtpSend()
Dim vPath As String
Dim vFile As String
Dim vFTPServ As String
Dim fNum As Long
vPath = "PATH OF WHERE TO STORE THE DOS COMMANDS IN A .TXT FILE" (for example: "[COLOR="Red"]c:[/COLOR]")
vFile = "FULL PATH OF FILE TO SEND"
vFTPServ = "www.MYDOMAIN.com" 'your server
'Mounting file command for ftp.exe
fNum = FreeFile()
Open vPath & "\FtpComm.txt" For Output As #fNum
Print #1, "USER UsernameHere" 'use this if a UN is required
Print #1, "PasswordHere" 'use this if a PASS is required
Print #1, "put " & vFile ' upload local filename to server file
Print #1, "close" ' close connection
Print #1, "quit" ' Quit ftp program
Close
Shell "ftp -n -i -g -s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalNoFocus
End function
Code:
function FtpSend()
Dim vPath As String
Dim vFile As String
Dim vFTPServ As String
Dim fNum As Long
vPath = "c:"
vFile = "c:\'documents and settings'\%username%\desktop" & _
inputbox("Give the file name to upload from your desktop...")
vFTPServ = "www.MYDOMAIN.com" 'your server
'Mounting file command for ftp.exe
fNum = FreeFile()
Open vPath & "\FtpComm.txt" For Output As #fNum
Print #1, "USER UsernameHere"
Print #1, "PasswordHere"
Print #1, "put " & vFile ' upload local filename to server file
Print #1, "close" ' close connection
Print #1, "quit" ' Quit ftp program
Close
Shell "ftp -n -i -g -s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalNoFocus
End function<EDIT>
MY NEEDS FOR THIS THING now have expanded beyond my wildest expectations, but because the people I work for are not interested in buying the "GoToMyPC" thing, I guess we do this instead, through Access no less! Wow...talk about using programs for what they were NOT intended for.
At any rate, here is something that will give the user a chance to select as many folders as they want to upload to a server root directory. As the upload takes place and you see the DOS window on screen doing it's magic, there is a box that pops up on top of that even that says something "Wait until it's done, then press OK". (it wont work this way for others, because my popup for is customize with plenty of code. but in general, here's the IDEA:
PHP:
Option Compare Database
Function FTPtransfer()
Dim varitem As Variant
Dim vPath As String
Dim vFile As String
Dim vFTPServ As String
Dim fNum As Long
vPath = "C:"
vFTPServ = "www.mydomain.com"
jumpdone = False
fNum = FreeFile()
Open vPath & "\FtpComm.txt" For Output As #fNum
Print #1, "USER MYUSERNAMEHERE" ' your login
Print #1, "PASSWORDHERE" ' your password
Print #1, "echo Press any key to pick your files to be transferred to the server"
Print #1, pause
With Application.FileDialog(msoFileDialogFilePicker)
With .Filters
.Clear
.Add "All Files", "*.*"
End With
.AllowMultiSelect = True
.InitialFileName = "c:\"
.InitialView = msoFileDialogViewDetails
If .Show Then
For Each varitem In .SelectedItems
If InStr(CStr(varitem), ".") > 0 Then
vFile = """" & varitem & """"
Print #1, "put " & vFile
End If
Next varitem
End If
End With
Print #1, "close" ' close connection
Print #1, "quit" ' Quit ftp program
Close
Shell "ftp -n -i -g -s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalNoFocus
DoCmd.OpenForm "msgboxOK"
Forms!msgboxOK!Message1.Caption = CStr(varitem) & _
" is uploading... Press OK when it has finished"
Forms!msgboxOK!Message1.Visible = True
While jumpdone = False
DoEvents
Wend
End FunctionHere's a substitute for buying an FTP program that I wrote for , to upload, download and delete files from there personal directories on the server. Below is the upload code and download code I used. Quite simple really...(uses DOS FTP):
PHP:
Function UploadServerFiles()
DoCmd.Close acForm, "MsgBoxSelect"
Dim varitem As Variant
Dim vPath As String
Dim vFile As String
Dim vFTPServ As String
Dim fNum As Long
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Uploads", dbOpenDynaset)
vPath = "C:"
vFTPServ = "www.mydomain.com"
jumpdone = False
fNum = FreeFile()
Open vPath & "\FtpComm.txt" For Output As #fNum
Print #1, "USER myUserName" ' your login
Print #1, "MyPassword" ' your password
Print #1, "cd MyPersonalServerDirectory" 'DAD'S DIRECTORY
With Application.FileDialog(msoFileDialogFilePicker)
With .Filters
.Clear
.Add "All Files", "*.*"
End With
.AllowMultiSelect = True
.InitialFileName = "c:\"
.InitialView = msoFileDialogViewDetails
If .Show Then
For Each varitem In .SelectedItems
If InStr(CStr(varitem), ".") > 0 Then
vFile = """" & varitem & """"
Print #1, "put " & vFile
rs.AddNew
rs!TransferPerson = application.currentuser
rs!fileuploaded = varitem
rs!UploadDate = Date
rs.Update
End If
Next varitem
End If
If .SelectedItems.Count > 0 Then
Cancelled = False
End If
End With
Print #1, "close" ' close connection
Print #1, "quit" ' Quit ftp program
Close
If Cancelled = False Then
Shell "ftp -n -i -g -s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalFocus
jumpdone = False
DoCmd.OpenForm "msgboxOK"
Forms!MsgBoxOK!Message1.Visible = True
While jumpdone = False
DoEvents
Wend
DoCmd.OpenTable "Uploads", acViewNormal, acReadOnly
DoCmd.Maximize
jumpdone = False
DoCmd.OpenForm "msgboxOK"
Forms!MsgBoxOK!mESSAGE2.Visible = True
While jumpdone = False
DoEvents
Wend
DoCmd.Close acTable, "Uploads"
End If
Cancelled = True
rs.Close
Set rs = Nothing
DoCmd.OpenForm "MsgBoxSelect"
End Function
PHP:
Function DownloadServerFiles()
Dim DownloadLoc As String
If DCount("fileuploaded", "uploads") < 1 Then
MsgBox "You have no files on the server", vbCritical
Exit Function
End If
DoCmd.Close acForm, "MsgBoxSelect"
DoCmd.SetWarnings False
Dim varitem As Variant
Dim vPath As String
Dim vFile As String
Dim vFTPServ As String
Dim fNum As Long
DoCmd.OpenQuery "Get", acViewNormal, acEdit
jumpdone = False
DoCmd.OpenForm "msgboxOK"
Forms!MsgBoxOK!Message5.Visible = True
While jumpdone = False
DoEvents
Wend
DoCmd.Close acQuery, "Get", acSaveYes
If DCount("fileuploaded", "uploads", "[get] = -1") < 1 Then
MsgBox "No files were Selected...", vbExclamation
DoCmd.OpenForm "MsgBoxSelect"
Exit Function
End If
MsgBox "Select your download location..."
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = "c:\"
.InitialView = msoFileDialogViewDetails
If .Show Then
For Each varitem In .SelectedItems
DownloadLoc = CStr(varitem) & "(forward slash) here"
Next varitem
End If
End With
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Get", dbOpenDynaset)
rs.MoveLast
rs.MoveFirst
vPath = "C:"
vFTPServ = "www.mydomain.com"
fNum = FreeFile()
Open vPath & "\FtpComm.txt" For Output As #fNum
Print #1, "USER UserName" ' your login
Print #1, "Password" ' your password
Print #1, "cd MyPersonalDirectory"
While Not rs.EOF
If rs!Get = -1 Then
vFile = Right(rs!fileuploaded, (Len(rs!fileuploaded) -
InStrRev(rs!fileuploaded, "\")))
Print #1, "get " & """" & vFile & """" & " " & DownloadLoc & vFile
End If
rs.MoveNext
Wend
Print #1, "close" ' close connection
Print #1, "quit" ' Quit ftp program
Close
rs.Close
Set rs = Nothing
jumpdone = False
DoCmd.OpenForm "msgboxOK"
Forms!MsgBoxOK!Message6.Visible = True
While jumpdone = False
DoEvents
Wend
Shell "ftp -n -i -g -s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalFocus
DoCmd.RunSQL "UPDATE Uploads SET Uploads.Get = 0"
DoCmd.SetWarnings True
DoCmd.OpenForm "MsgBoxSelect"
End Function
Last edited:
