Go Back   Access World Forums > Microsoft Access Reference > Code Repository

 
Reply
 
Thread Tools Rating: Thread Rating: 135 votes, 5.00 average. Display Modes
Old 08-24-2009, 05:35 PM   #1
ajetrumpet
Banned
 
Join Date: Jun 2007
Location: Universe - Local Group - Milky Way Galaxy - Orion Arm
Posts: 5,640
Thanks: 0
Thanked 100 Times in 47 Posts
ajetrumpet has a spectacular aura about ajetrumpet has a spectacular aura about
Send a message via MSN to ajetrumpet Send a message via Yahoo to ajetrumpet
Using FTP in VBA

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...
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: "c:")
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
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...
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 Code:
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 ----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 Function 
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):
PHP Code:
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 ----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 Code:
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"acViewNormalacEdit

                            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 slashhere"
                      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 ----s:" & vPath & "\FtpComm.txt " & vFTPServ, vbNormalFocus

DoCmd.RunSQL "
UPDATE Uploads SET Uploads.Get 0"
DoCmd.SetWarnings True
DoCmd.OpenForm "
MsgBoxSelect"

End Function 
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!
Attached Files
File Type: zip FTP.zip (60.9 KB, 4219 views)


Last edited by ajetrumpet; 12-31-2009 at 07:13 PM.
ajetrumpet is offline   Reply With Quote
The Following User Says Thank You to ajetrumpet For This Useful Post:
Guus2005 (10-22-2013)
Old 09-10-2009, 02:21 AM   #2
DCrake
Remembered
 
DCrake's Avatar
 
Join Date: Jun 2005
Location: Burnley, Lancashire
Posts: 8,634
Thanks: 8
Thanked 325 Times in 208 Posts
DCrake is a glorious beacon of light DCrake is a glorious beacon of light DCrake is a glorious beacon of light DCrake is a glorious beacon of light DCrake is a glorious beacon of light DCrake is a glorious beacon of light
Send a message via Skype™ to DCrake
Re: Using FTP in VBA

Hi AJ,
Actually using VB to for my FTP applet. here is the code so far.


Code:
   'Variables
    sServer = txtServer.Text
    sUser = txtUser.Text
    sPassword = txtPassword.Text
    sDir = txtDir.Text
    sLocal = App.Path & "\Database\" & TxtFile.Text
    sRemote = "\docs\stuff\" & TxtFile.Text
    
    'Save values to remember
    SaveSetting "PutGet FTP", "Values", "Server", txtServer.Text
    SaveSetting "PutGet FTP", "Values", "User", txtUser.Text
    SaveSetting "PutGet FTP", "Values", "Password", txtPassword.Text
    SaveSetting "PutGet FTP", "Values", "Directory", txtDir.Text
    
'Open INTERNET
    hOpen = InternetOpen("PutGet FTP", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hOpen = 0 Then 'ZERO means Internet Coudn't Open
        MsgBox "Error: " & Err.LastDllError, 32, "Internet Conection Error"
        Status.Caption = "Disconnected..."
        Exit Sub
    End If
    Status.Caption = "Internet Open..."
    
    dwType = FTP_TRANSFER_TYPE_BINARY 'SET TO BINARY
    dwSeman = 0 'Set Conection Active
    hConnection = 0 'Reset Conection
    
'Connect to server
    hConnection = InternetConnect(hOpen, sServer, INTERNET_INVALID_PORT_NUMBER, sUser, sPassword, INTERNET_SERVICE_FTP, dwSeman, 0)
    If hConnection = 0 Then 'ZERO means can't connect to Server
        MsgBox "Error: " & Err.LastDllError, 32, "Server Conection Error"
        Status.Caption = "Disconnected..."
        Exit Sub
    End If
    Status.Caption = "Connected to Server..."

'Specify Initial Directory
    OpenDir = FtpSetCurrentDirectory(hConnection, sDir)
    If OpenDir = False Then 'False means specified directory is wrong
        MsgBox "Error: " & Err.LastDllError, 32, "Initial Directory Error"
        Status.Caption = "Disconnected..."
        If hConnection <> 0 Then 'Disconnect if is still conected
            Cerrar = InternetCloseHandle(hConnection)
        End If
        Exit Sub
    End If
    Status.Caption = "Directory Ready..."
Everything woks up to this point

The put file below fails as Subir = False

Code:
'Put File
    Subir = FTPPutFile(hConnection, sLocal, sRemote, dwType, 0)
    If Subir = False Then 'False means couldn't send the file
        MsgBox "Error: " & Err.LastDllError, 32, "File Transfer Error"
        Status.Caption = "Disconnected..."
        If hConnection <> 0 Then 'Disconnect if is still conected
            Cerrar = InternetCloseHandle(hConnection)
        End If
        Exit Sub
    End If
    Status.Caption = "Sending File..."
Having read what's there I'm wondering if Subir should infact be SubDir
Going to test it.
Code:
'Close conection
    If hConnection <> 0 Then
        Cerrar = InternetCloseHandle(hConnection)
        Status.Caption = "Disconnected..."
    End If
Tried it, still have problems! Any idea what could be preventing the file transfer bit.

David
__________________
David Crake


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
The Home of Simple Software Solutions.

O/S Windows XP (SP3) & Windows 7 64bit
Access 2003 (version 11.0)
Access 2007 (version 12.0)

Remember when posting sample databases you will get a better response if it is pre Access 2007 - not all people have it installed.

Last edited by DCrake; 09-10-2009 at 02:32 AM.
DCrake is offline   Reply With Quote
The Following User Says Thank You to DCrake For This Useful Post:
Guus2005 (10-22-2013)
Old 12-17-2010, 08:07 AM   #3
KirkComer
Newly Registered User
 
Join Date: Oct 2005
Posts: 50
Thanks: 2
Thanked 0 Times in 0 Posts
KirkComer is on a distinguished road
Re: Using FTP in VBA

ajetrumpet,

I know this is a old post but thank you so much for posting this ftp to network database! I do have one question about it. For example if I wanted to save a ftp file to a folder in my C drive what is the proper way to type this?

Example 1 (this works)
Me.Text26 = "C:\"
Call FillList("C:\")

Example 2 (this doesn't)
Me.Text26 = "C:\Test Folder"
Call FillList("C:\Test Folder")

It seems like it should work. I highlight the file and click "Download File". No error message appear but the file does not tranfer to the folder. Probably just something small but my simple brain can not figure it out. lol

KirkComer is offline   Reply With Quote
Old 12-20-2010, 09:43 AM   #4
boblarson
Smeghead
 
boblarson's Avatar
 
Join Date: Jan 2001
Location: Oregon, USA
Posts: 32,068
Thanks: 97
Thanked 1,828 Times in 1,579 Posts
boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold
Re: Using FTP in VBA

Quote:
Originally Posted by KirkComer View Post
ajetrumpet,

I know this is a old post but thank you so much for posting this ftp to network database! I do have one question about it. For example if I wanted to save a ftp file to a folder in my C drive what is the proper way to type this?

Example 1 (this works)
Me.Text26 = "C:\"
Call FillList("C:\")

Example 2 (this doesn't)
Me.Text26 = "C:\Test Folder"
Call FillList("C:\Test Folder")

It seems like it should work. I highlight the file and click "Download File". No error message appear but the file does not tranfer to the folder. Probably just something small but my simple brain can not figure it out. lol
What if you put the slash like the first example has:

Me.Text26 = "C:\Test Folder\"
Call FillList("C:\Test Folder\")
__________________

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
boblarson is offline   Reply With Quote
Old 12-20-2010, 09:50 AM   #5
KirkComer
Newly Registered User
 
Join Date: Oct 2005
Posts: 50
Thanks: 2
Thanked 0 Times in 0 Posts
KirkComer is on a distinguished road
Re: Using FTP in VBA

Yes. I also tried (I'm guessing you didn't want me to use the *):

Example 3
Me.Text26 = "C:\Test Folder\"
Call FillList("C:\Test Folder\")

I can make do with just putting it on my C:\ drive for now but if anyone comes up with a solution please let me know.
KirkComer is offline   Reply With Quote
Old 12-20-2010, 09:57 AM   #6
boblarson
Smeghead
 
boblarson's Avatar
 
Join Date: Jan 2001
Location: Oregon, USA
Posts: 32,068
Thanks: 97
Thanked 1,828 Times in 1,579 Posts
boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold
Re: Using FTP in VBA

Quote:
Originally Posted by KirkComer View Post
Yes. I also tried (I'm guessing you didn't want me to use the *):

Example 3
Me.Text26 = "C:\Test Folder\"
Call FillList("C:\Test Folder\")

I can make do with just putting it on my C:\ drive for now but if anyone comes up with a solution please let me know.
I'm guessing that the code doesn't like the spaces in the folders and is using the older 8.3 file naming structure. See what happens if you have a test folder named:

C:\testFold\

and see if it works then.
__________________

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
boblarson is offline   Reply With Quote
Old 12-20-2010, 10:14 AM   #7
KirkComer
Newly Registered User
 
Join Date: Oct 2005
Posts: 50
Thanks: 2
Thanked 0 Times in 0 Posts
KirkComer is on a distinguished road
Re: Using FTP in VBA

Yep. I tried. Still no luck. Thanks for the suggestions.

Example 4
Me.Text26 = "C:\TestFolder\"
Call FillList("C:\TestFolder\")

Example 5
Me.Text26 = "C:\TestFolder"
Call FillList("C:\TestFolder")

KirkComer is offline   Reply With Quote
Old 12-20-2010, 10:20 AM   #8
boblarson
Smeghead
 
boblarson's Avatar
 
Join Date: Jan 2001
Location: Oregon, USA
Posts: 32,068
Thanks: 97
Thanked 1,828 Times in 1,579 Posts
boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold
Re: Using FTP in VBA

Quote:
Originally Posted by KirkComer View Post
Yep. I tried. Still no luck. Thanks for the suggestions.

Example 4
Me.Text26 = "C:\TestFolder\"
Call FillList("C:\TestFolder\")

Example 5
Me.Text26 = "C:\TestFolder"
Call FillList("C:\TestFolder")
Apparently you didn't pay attention. I said

C:\TestFold\

Not
C:\TestFolder

TestFold is 8 characters long, which is what 8.3 uses. Remember back when you could not use file or folder names longer than 8 characters? Well, I think this is what is happening. Try using

C:\TestFold\

(8 characters)

and only 8 characters for the file name as well.

See what happens.
__________________

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
boblarson is offline   Reply With Quote
Old 12-20-2010, 10:32 AM   #9
KirkComer
Newly Registered User
 
Join Date: Oct 2005
Posts: 50
Thanks: 2
Thanked 0 Times in 0 Posts
KirkComer is on a distinguished road
Thumbs up Re: Using FTP in VBA

Cha-Ching! This worked!!

Example 6
Me.Text26 = "C:\Test\"
Call FillList("C:\Test\")

Thank you soooooo muuccchhhh!

KirkComer is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Navigate Internet Explorer using VBA ajetrumpet Access FAQs 4 08-11-2010 09:00 AM
Major problems with VBA davidjearly Modules & VBA 8 07-29-2010 04:35 AM
vba class mikevds Forms 5 02-25-2009 10:53 AM
Error handling: report bombs at VBA function when query returns no records chris klein Modules & VBA 3 12-02-2008 12:32 PM
Need VBA in a database - but cant think what for crazymarvin Modules & VBA 2 06-03-2007 08:06 AM




All times are GMT -8. The time now is 12:18 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World