Start Free Trial

asked on

How to send command to cmd.exe shell in windows by VBA

Dear Experts,

I would like to send a html.file to my own web domain name for every 5 minutes through one FTP/telnet program , pscp.exe and embeded
all information such as filename, webhost IP, Port id in one batch file with the pspc.exe , for example, "pscp.bat"
And I would like to use one fix CMD.exe shell to do all tasks for every 5-minute so I need to know how
to send any DOS comand to dedicated window shell like CMD.exe shell. I try this VBA code as follows but it deson't
response from the API SendDlgItemMessageW and Postmessage

Question-1 WE can get the process id , revtal of cmd.exe shell by shell in VBA and handle of the Shell , hdlg. I don't
know which method is better using processid or handle to send command to the window shell(cmd.exe shell)
Could you provide a little direction for that ?
Question-2, Actully, I can run Shell("cmd.exe" /c "pscp.bat", vbNormalFocus) and after that close the shell windows and start over
again for each 5- minutes, but it will create sceen flicking for loop operation and I believe no one will do that way for file transfer
for each 5-minutes. So i think I need to create the shell once and do the fileupload looping by other VBA code and method in
the same exact window shell, Is it correct ? Any suggestion ? Please free feel to point my mistake in the following VBA sub

Duncan

" Testing VBA code for upload file each 5 minutes in CMD.exe windows shell
Sub fileuploadtest()
Dim retval As Variant
Dim hdlg As Long
retval = Shell("CMD.exe", vbNormalFocus)
' it will create a window and its title called "C:\Windows\system32\cmd.exe")
hdlg = FindWindow(vbNullString, "C:\Windows\system32\cmd.exe")
call shellcommandtest(hdlg)

End Sub

Sub shellcommandtest(hdlg as long)
Call SendDlgItemMessageW(hdlg, &H47C&, WM_SETTEXT, 0, StrPtr("pscp.bat"))
PostMessage hDlg, WM_KEYDOWN, &HD&, vbNullString 'Send ENter key to the shell
If timevalue(time()) < timevalue("12:00:00") then
Call timer
Else
SendMessage hDlg, WM_CLOSE, 0, 0 ' Finished all upload and close the CMD shell window when time is "12:00:00"
End If
End Sub

Sub Timer()
Application.OnTime Time + TimeValue("00:05:00"), "shellcommandtest"
End Sub

Guess, but if your batch file exits when its finished then just shell the batch file directly & use the flag 'hide' rather than 'normal focus'. Then there should be no need to send messages to the cmd window nor close it , as it will terminate when finished. PS - Im basing this on my experience with AutoIT scripting language NOT VBA (may or may not use similar paradigms!) so this might not work at all, but worth a try if you feel like it.....

ASKER

Because the file data is extracted in real-time from one vendor website by my own VBA code into excel file as data.htm and do a lot of math calcaulation before updload the data file so I need to activate the CMD shell at the same for uploading in order to save time.

nffvrxqgrcfqvvc

Do you need to use a batch file for any specific reason? If you do it's not very clear what you need the batch file for in your question.
Upload file to FTP w/progress
http:Q_26291032.html

ASKER

actually it doesn't matter because the pscp.bat inside just a command like this
pscp -P 651111 myfile.htm username@174.123.34.3444:/home/myusername/public_html

ASKER

pscp is just a exe program for user to upload and download file to the dedicated IP address if known the passwords

nffvrxqgrcfqvvc

Okay. You could use the example in VBA to upload the file to FTP site. You can add the example code a module and it will do the FTP operation directly then you don't need to depend on pscp would that work for you?

FtpPutFileEx "174.123.34.3444", "user", "pass", "c:\path\myfile.htm", "/home/myusername/public_html/myfile.htm"

Open in new window

ASKER

Do i need specify the port like 651111 in ftpputfileex ? and how about copy a directory recurisvely
to a directoy ?
By the way, I overcome the probelm to sendkey to comand shell, just get the handles , make the shell windows set to forgroundwindow and send anything I want by sendkeys but that is not practical
and I switch to look into ftpputfileEx
Thanks, at least I know there is API function ftipputfileEx for FTP , API library is really big

nffvrxqgrcfqvvc

Yes you can change the port, the default port used is 21 look at the top of the example for the constant @ line 11 in that example
" Private Const INTERNET_DEFAULT_FTP_PORT = 21 "
Replace the value 21 with the required port number.
But my concern is if you can do this directly within your workbook or VBA then you don't need the batch file and it would be much faster not to mention removes all the headache involved of using sendkeys....

ASKER

Last Last question before testing your Extentsion API FTP function.

Can the function be able to transfer a directoy to website?
Can the function transfer the file which is already in edit mode ?

I used the pscp.exe program which not allow the file is in edit mode to be sent that is
a issue because I want to send my working file after activebooks.save .My understand it should be no problem
because ftp could send the mirror of file to the website, and not neccessary to wait for
the file closed. Right ?

nffvrxqgrcfqvvc

1) Yes but that requires extra work like enumerating the directory on the local drive then uploading them, there is not direct FTP function to upload a directory so you have to do it individually for each file enumerated in the folder. You may also want to consider moving the connection code and the uploading portion so you don't connect and disconnect for each file if you plan on uploading a bunch of files.
2) This ALL depends on how the application that has the file open in edit mode has accessed the file. If the application opened it with share read access it will work if it doesn't provide share access then you won't be able to read the file while it's edit mode. This is a limitation of the application who has the file open in edit mode not the source code. (However the pscp might not be using the right flags for that to work.

ASKER

It report "InternetConnectW()12111" in the debug window of VBA . Is that mean not okay? What is
error code meaning
I check my website, there is no such file download

nffvrxqgrcfqvvc

The example uploads files, it doesn't download files. To download a file it's completley different. The error code means the following.

ERROR_FTP_DROPPED
12111
The FTP operation was not completed because the session was aborted.

Open in new window

ASKER

sorry it is upload from my computer to the website.

Private Const INTERNET_DEFAULT_FTP_PORT = 651111
filename=activeworkbooks.path & "\example.htm"
debug.print filename 'It checked no problem at all here
FtpPutFileEx "174.123.34.3444", "myusername", "mypasswd", filename, "/home/myusername/public_html/junktest.htm"

And then g6 back to pspc.exe, it is working for IP and the port ID

nffvrxqgrcfqvvc

You have me confused now, is the example working? Did you change anything around in the example? Do you have other FTP software open that could prevent more than one session from connecting to the ftp site?

ASKER

I close other ftp program when try the FTPputFileEx

ASKER

I mean I try the following code and get error 12111
Private Const INTERNET_DEFAULT_FTP_PORT = 651111
filename=activeworkbooks.path & "\example.htm"
debug.print filename 'It checked no problem at all here
FtpPutFileEx "174.123.34.3444", "myusername", "mypasswd", filename, "/home/myusername/public_html/junktest.htm"

nffvrxqgrcfqvvc

Okay. Use this example instead, I added the INTERNET_FLAG_PASSIVE and INTERNET_OPEN_TYPE_DIRECT flag. Don't know the requirments of your FTP site...

Option Explicit

Private Const BUF_SIZE = 4096 ' 4KB default buffer for FTP
 
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const OPEN_EXISTING = &H3&
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_DEFAULT_FTP_PORT = 651111
Private Const FTP_TRANSFER_TYPE_UNKNOWN = 0
 
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnectW Lib "wininet" (ByVal hInternetSession As Long, ByVal sServerName As Long, ByVal nServerPort As Long, ByVal sUsername As Long, ByVal sPassword As Long, ByVal lService As Long, ByVal lFlags As Long, ByVal lcontext As Long) As Long
Private Declare Function InternetWriteFile Lib "wininet" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToWrite As Long, ByRef lpdwNumberOfBytesWritten As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long
Private Declare Function FtpOpenFileW Lib "wininet" (ByVal hConnect As Long, ByVal lpszFileName As Long, ByVal dwAccess As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long

Dim Buffer(BUF_SIZE) As Byte
Dim dwReadBytes As Long
Dim dwWrittenBytes As Long
Dim hOpen As Long
Dim hConnect As Long
Dim hInternet As Long
Dim hFile As Long
 
 
Public Sub FtpPutFileEx( _
  ByVal szServer As String, _
  ByVal szUser As String, _
  ByVal szPassword As String, _
  ByVal szLocalFile As String, _
  ByVal szServerFile As String)
  
  Dim dwStatus As Long
  Dim dwLoFileSize As Long
  Dim dwHiFileSize As Long
  Dim dwPercent As Long
  
  hOpen = InternetOpenW(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)

  '// connect to the ftp server
  hConnect = InternetConnectW(hOpen, StrPtr(szServer), INTERNET_DEFAULT_FTP_PORT, _
    StrPtr(szUser), _
    StrPtr(szPassword), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
   
  If hConnect = 0 Then
    CleanUp
    Debug.Print "InternetConnectW()" & Err.LastDllError
    Exit Sub
  End If
   
  '// get handle for filename that will be written to the ftp server
  hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, FTP_TRANSFER_TYPE_UNKNOWN, 0)
   
  If hInternet = 0 Then
    CleanUp
    Debug.Print "FtpOpenFile()" & Err.LastDllError
    Exit Sub
  End If
   
  '// get handle for local file to read bytes
  hFile = CreateFileW(StrPtr("\\?\" & szLocalFile), GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0)
   
  If hFile = INVALID_HANDLE_VALUE Then
    CleanUp
    Debug.Print "CreateFileW()" & Err.LastDllError
    Exit Sub
  End If
  
  ' // get local file size for progress. This example supports
  '    only up to 2GB of status reporting progress.
  dwLoFileSize = GetFileSize(hFile, dwHiFileSize)
  
  '// read local file, write server file bytes
  Do
    If ReadFile(hFile, VarPtr(Buffer(0)), BUF_SIZE, dwReadBytes, 0) Then
      If InternetWriteFile(hInternet, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes) Then
        ' Track the amount of bytes written and percentage.
        dwStatus = (dwStatus + dwWrittenBytes)
        dwPercent = (dwStatus / dwLoFileSize) * 100
        'Label1.Caption = dwPercent
      End If
    Else
      Exit Do
    End If
    DoEvents
  Loop Until dwReadBytes = 0
   
  Debug.Print "Done"
  '// cleanup
  CleanUp
  Erase Buffer
   
  
End Sub
 
Private Sub CleanUp()
   
  If hOpen <> 0 Then
    InternetCloseHandle hOpen
    hOpen = 0
  End If
  If hConnect <> 0 Then
    InternetCloseHandle hConnect
    hConnect = 0
  End If
  If hInternet <> 0 Then
    InternetCloseHandle hInternet
    hInternet = 0
  End If
  If hFile > 0 Then
    CloseHandle hFile
    hFile = INVALID_HANDLE_VALUE
  End If
   
End Sub

Open in new window

ASKER

it is same as before with error 121111 and also the problem is that could go through hconnect , always hconnect=0

Duncan

ASKER

TYPING mistake "could "NOT" go through
it is same as before with error 121111 and also the problem is that could "NOT" go through hconnect , always hconnect=0

Duncan

nffvrxqgrcfqvvc

Did you try to upload to the root or to a directory that doesn't contain an _ underscore?

ASKER

It is same as before with error
It hange up here around 50 seconds
hConnect = InternetConnectW(hOpen, StrPtr(szServer), INTERNET_DEFAULT_FTP_PORT, _
StrPtr(szUser), _
StrPtr(szPassword), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)

nffvrxqgrcfqvvc

BTW: You sure the port is suppose to be 651111? I would try using 21 just to be certain. Do you have a firewall it might be blocking access to the port and not allowing VBA to connect..

ASKER

I shoud be not problem because I am using VBA program to connect my bank account daily using
IE.navigate because already change those security setting in IE
Waiting,, it seems port 21 is okay

ASKER

THe message is FtpOpenFile()6 and right away to show it out whtout 50 seconds
but I check my website there is not the file I upload

nffvrxqgrcfqvvc

There is something on your end preventing this from working whether it be the specific port being blocked or some other settings that might be required for your specific FTP site. I can verify it works no problem with other FTP services.
The error means "The handle is invalid" try closing VBA to clear up handles and chec firewall settings to ensure it's not being blocked on the port you need to use.

ASKER

Finally, it works with the following condition

1- Set back to port 21 from 651111 which is provided by my website company for using pscp.exe for ftp
2- FtpPutFileEx "174.123.34.3444", "myusername", "mypasswd", filename, "junstest.html" in which
I don't specifiy the server side path name

The file, junktest.html is shown on my website finally so the second item problem is at
the server pathname setup... Shoud we put ":/home/username/public_html/junktest.html" add ":" before home ?

ASKER

it might be related to public_html, the underscore issue, Possible

nffvrxqgrcfqvvc

LOL... Well atleast we know it works at this point. It might use a different heirachy convention so if it's required to pass the character ' : ' then that may be what needs to be done. I would try all possible combinations to know for sure you could use FtpGetCurrentDirectory() this would return the current directory string.. See what it returns, for example on my FTP server in the root only it returns /
You can add the following to line 59 of the example.
MsgBox GetCurrentDirectory

Private Declare Function FtpGetCurrentDirectoryW Lib "wininet.dll" (ByVal hConnect As Long, ByVal lpszCurrentDirectory As Long, ByRef lpdwCurrentDirectory As Long) As Long

 Public Function GetCurrentDirectory() As String
    Dim cbLength As Long
    Dim dirBuffer(4096) As Byte
    cbLength = 4096
    If FtpGetCurrentDirectoryW(hConnect, VarPtr(dirBuffer(0)), cbLength) Then
       GetCurrentDirectory = Left$(dirBuffer, cbLength)
    Else
        GetCurrentDirectory = vbNullString
    End If
 End Function

Open in new window

ASKER

I put it at line 59 in the thread last FtpPutFileEx code sending as follows

MsgBox GetCurrentDirectory
'// get handle for filename that will be written to the ftp server
hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, FTP_TRANSFER_TYPE_UNKNOWN, 0)

The Msgox message is "/", what is function for MsgBox GetCurrentDirectory ?

ASKER CERTIFIED SOLUTION

nffvrxqgrcfqvvc

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

FtpSetCurrentDirectoryW hConnect, StrPtr("/home/ehftrade/public_html/")
MsgBox GetCurrentDirectory
'// get handle for filename that will be written to the ftp server
hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, FTP_TRANSFER_TYPE_UNKNOWN, 0)

After putting the new API, the msgbox report same as "/"

Duncan

nffvrxqgrcfqvvc

Well seems like a problem here then...
Try different ones to see at which point it fails...

FtpSetCurrentDirectoryW hConnect, StrPtr("/home")
FtpSetCurrentDirectoryW hConnect, StrPtr("/home/")
FtpSetCurrentDirectoryW hConnect, StrPtr("/home/ehftrade")
FtpSetCurrentDirectoryW hConnect, StrPtr("/home/ehftrade/")

Open in new window

ASKER

It works finally at public_html
just put it as "/public_html/junktest.html"
only without "/home/username"
Why adding these because the
pscp is working for that and told
by the operator of webiste support .

ASKER

THe upload file is ftp to "/public_html/junktest.html"

Thanks Egl1044's reply and great help

ASKER

Dear Adm of EE,

I would like to re-credit this thread since I made mistake to tick others for assisted solution for KeniBrown2 . Please help me to ressume the re-credit procedure and process
Duncan

ASKER

Dear Eg1044,

I would like to like in your code provide, why we need to ftopfileopen() to open since
I just need upload files to the server. I run the code and found the speed of
FTP is really slow comparing to other softwer like pscp.exe. Is that because
you add some read file code in the subroutine or function to slow down
the upload process. Is it possible to modfiy the code to speed it uo.

Why not using FTIPput file directly ? but I tried it fail .
FtpPutFile(hConnect, StrPtr(szServerFile), StrPtr(szLocalFile), FTP_TRANSFER_TYPE_UNKNOWN, 0), Why ?

Please advise

Duncan

ublic Function FtpPutFileEx( _
  ByVal szServer As String, _
  ByVal szUser As String, _
  ByVal szPassword As String, _
  ByVal szLocalFile As String, _
  ByVal szServerFile As String, _
  ByVal filetype As Long) As Boolean
  Dim dwStatus As Long
  Dim dwLoFileSize As Long
  Dim dwHiFileSize As Long
  Dim dwPercent As Long
  Dim a As Variant
  hOpen = InternetOpenW(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
 '// connect to the ftp server
  hConnect = InternetConnectW(hOpen, StrPtr(szServer), INTERNET_DEFAULT_FTP_PORT, _
    StrPtr(szUser), _
    StrPtr(szPassword), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
    If hConnect = 0 Then
    CleanUp
    Debug.Print "InternetConnectW()" & Err.LastDllError
    FtpPutFileEx = False
    Exit Function
  End If
'  Dim success As Boolean
 ' success = False
 ' Do Until success = True
  
 ' success = FtpPutFile(hConnect, StrPtr(szServerFile), StrPtr(szLocalFile), FTP_TRANSFER_TYPE_UNKNOWN, 0)
 ' Loop
 '  Exit Function
 
    'MsgBox GetCurrentDirectory
  '// get handle for filename that will be written to the ftp server
  'Call FtpSetCurrentDirectory(hConnect, sdir)

 ' a = Time()
 ' Do Until hInternet <> 0 Or TimeValue(Time()) - TimeValue(a) > TimeValue("00:00:59")
  hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, filetype, 0)
 ' Loop
  
  If hInternet = 0 Then
    CleanUp
    Debug.Print "FtpOpenFile()" & Err.LastDllError
     FtpPutFileEx = False
    Exit Function
  End If
   
  '// get handle for local file to read bytes
  hFile = CreateFileW(StrPtr("\\?\" & szLocalFile), GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0)
   
  If hFile = INVALID_HANDLE_VALUE Then
    CleanUp
    Debug.Print "CreateFileW()" & Err.LastDllError
     FtpPutFileEx = False
    Exit Function
  End If
  
  ' // get local file size for progress. This example supports
  '    only up to 2GB of status reporting progress.
  dwLoFileSize = GetFileSize(hFile, dwHiFileSize)
  
  '// read local file, write server file bytes
  Do
    If ReadFile(hFile, VarPtr(Buffer(0)), BUF_SIZE, dwReadBytes, 0) Then
      If InternetWriteFile(hInternet, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes) Then
        ' Track the amount of bytes written and percentage.
        dwStatus = (dwStatus + dwWrittenBytes)
        dwPercent = (dwStatus / dwLoFileSize) * 100
        'Label1.Caption = dwPercent
      End If
    Else
      Exit Do
    End If
    DoEvents
  Loop Until dwReadBytes = 0
    FtpPutFileEx = True
  Debug.Print "Done"
  '// cleanup
  CleanUp
  Erase Buffer
   
  
End Function

Private Sub CleanUp()
   
  If hOpen <> 0 Then
    InternetCloseHandle hOpen
    hOpen = 0
  End If
  If hConnect <> 0 Then
    InternetCloseHandle hConnect
    hConnect = 0
  End If
  If hInternet <> 0 Then
    InternetCloseHandle hInternet
    hInternet = 0
  End If
  If hFile > 0 Then
    CloseHandle hFile
    hFile = INVALID_HANDLE_VALUE
  End If
   
End Sub

Open in new window

nffvrxqgrcfqvvc

I used the default FTP buffer size 4096 bytes per block. You might see an increase in performance if you change it to 65536 64KB per block.
Look at the constant value in my example and change BUF_SIZE = 4096 to the following > BUF_SIZE = 65536
This would give better results, let me know if it becomes faster :)
What is the difference you ask? Well FtpPutFile() is a synchronous call which will blocks the thread. If you use it then no controls on a UserForm as we;; as the userform will not be operational until it has finished. The extended version allows the application thats uploading the file to process messages to the UserForm and controls giving the user a chance to still interact with such while the file is being uploaded. If you don't have a UserForm or don't want t report progress then you can use FtpPutFile().