powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / удаление файлов на ftp по маске с помощью утилиты ftp.exe
4 сообщений из 4, страница 1 из 1
удаление файлов на ftp по маске с помощью утилиты ftp.exe
    #34575564
babken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Приложение должно:
1 удалять старые файлы csv c локального диска
2 копировать новые файлы с ftp
3 добавлять в них новые строки с помощью процедуры Module1.Anketa
4 удалять файлы на ftp (команда mdel насколько я понял).
5 копировать файлы с новыми строками.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
Public my_names( 1  To  5 ) As String
'путь к утилите ftp.exe В win 2000"c:\winnt\system32\ftp.exe"
Public Const FTPprogrampath As String = "C:\WINDOWS\system32\ftp.exe"
Public Const localFolder As String = "c:\hr\"
Public Const remoteFolder As String = "/in/"
Public Const ftp_host As String = "192.168.1.113"
Public Const user_name As String = "test"
Public Const psw As String = "test"

Option Explicit

Sub engine()

    PerformFileTransfer "mget", True
    
    Module1.Anketa
    
    PerformFileTransfer "mdel", False
    
    PerformFileTransfer "mput", False
    
    msgbox ("Все данные успешно выгружены!")

End Sub

Sub PerformFileTransfer(TransferCommand As String, kill_old As Boolean)

Dim i As Double, transferMode As String, j As Integer
Dim curFolder As String ', localFolder As String, remoteFolder As String
'очищаем старые файлы из локальной директории
Dim fs, my_names, nam
Set fs = CreateObject("Scripting.FileSystemObject")
If kill_old = True Then
    If Not fs.FolderExists(localFolder) Then
        fs.CreateFolder (localFolder)
    Else
        If fs.FileExists(localFolder & "com.csv") Then
            Kill localFolder & "\*.csv" '?
        End If
    End If
End If
'''''''''''''''''''
If Dir(FTPprogrampath) = "" Then
    msgbox "Please enter the correct path and file name to the FTP program.", _
        vbExclamation, "Invalid FTP program path and file name"
    Exit Sub
End If
If TransferCommand <> "mget" And TransferCommand <> "mput" Then
    msgbox "Valid commands are ""mget"" and ""mput"".", vbExclamation, "Invalid transfer command"
    Exit Sub
End If
If Right(localFolder,  1 ) <> "\" Then
    msgbox "Add a ""\"" at the end of the local folder name.", _
        vbExclamation, "Missing path separator!"
    Exit Sub
End If
If remoteFolder <> "" Then
    If Right(remoteFolder,  1 ) <> "/" Then
        msgbox "Add a ""/"" at the end of the remote folder name.", _
            vbExclamation, "Missing path separator!"
        Exit Sub
    End If
End If
curFolder = CurDir
On Error Resume Next
ChDrive Left(localFolder,  1 ) ' change drive
ChDir localFolder ' change to the local folder
'On Error GoTo 0
i = Shell(FTPprogrampath, vbMaximizedFocus) ' start ftp program
Application.Wait Now + TimeValue("00:00:05") ' give the program time to activate
PerformSendKeys "open " & ftp_host 'Range("B3").Formula ' open the connection
PerformSendKeys user_name 'Range("B4").Formula ' enter username
PerformSendKeys psw 'Range("B5").Formula ' enter password
PerformSendKeys "hash" ' enable hash markings for each datablock transfered (2048 byte)
PerformSendKeys "prompt" ' disable confirmation prompts
If remoteFolder <> "" Then PerformSendKeys "cd " & remoteFolder ' change to the remote folder
' start file transfer

transferMode = "ascii"
PerformSendKeys transferMode ' режим ascii для текстовых файлов, binary для остальных
'        For Each nam In my_names
    If TransferCommand = "mget" Then ' получаем файлы с ftp
        PerformSendKeys TransferCommand & " " & remoteFolder & "*.csv"
    End If
    If TransferCommand = "mdel" Then ' удаляем старые файлы с ftp
        PerformSendKeys TransferCommand & " " & remoteFolder & "*.csv"
    End If
    If TransferCommand = "mput" Then ' кладем новые файлы на ftp
        Application.Wait Now + TimeValue("00:00:01") 'd
        PerformSendKeys TransferCommand & " " & localFolder & "*.csv"
    End If

    'PerformSendKeys "y", 10 ' acknowledge transfer if not confirmation promts are disabled
Application.Wait Now + TimeValue("00:00:01") 'd
PerformSendKeys "bye" ' disconnect and quit FTP
'    PerformSendKeys "exit" ' close shell
AppActivate Application.Caption ' activate this program
ChDrive Left(curFolder,  1 ) ' change drive
ChDir curFolder ' change back to the initial folder
End Sub

Sub PerformSendKeys(KeyString As String)
    SendKeys KeyString, True ' send KeyString
    SendKeys "~", True ' send ENTER key
End Sub

Все кроме пункта 4 отрабатывает без проблем. При попытке выполнить PerformFileTransfer "mdel", False выдается msgbox "Invalid transfer command", Valid command are "mget" and "mput"
В чем ошибка? Есть ли более надежные способы передачи данных по ftp?

Использую, win xp ms office 2003

С уважением,
...
Рейтинг: 0 / 0
удаление файлов на ftp по маске с помощью утилиты ftp.exe
    #34575647
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
FTP.EXE не пробовал, поэтому не знаю возможностей. Сам делал через API? думаю там все получится. Вот отсюда можно начать http://www.codenet.ru/progr/vbasic/FTP.php
...
Рейтинг: 0 / 0
удаление файлов на ftp по маске с помощью утилиты ftp.exe
    #34576001
White Owl
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
babken4 удалять файлы на ftp (команда mdel насколько я понял).
делай раз: запускай ftp.exe
делай два: пиши в его командной строке help
делай три: внимательно читай список команд.
После того как убедишься что нету такой команды mdel - а есть mdelete, сам себе придумаешь наказание и мужественно его примешь.


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
i = Shell(FTPprogrampath, vbMaximizedFocus) ' start ftp program
Application.Wait Now + TimeValue("00:00:05") ' give the program time to activate
PerformSendKeys "open " & ftp_host 'Range("B3").Formula ' open the connection
PerformSendKeys user_name 'Range("B4").Formula ' enter username
PerformSendKeys psw 'Range("B5").Formula ' enter password
PerformSendKeys "hash" ' enable hash markings for each datablock transfered (2048 byte)
... etc
Не эффективно.
Намного проще и удобнее будет сформировать текстовый файл со всеми командами для ftp, а потом отдать его на выполнение. Например так:
Код: plaintext
1.
2.
3.
4.
5.
6.
declare function WaitForSingleObject lib "kernel32" (long hHandle, long dwMilliseconds) as long
const INFINITE =  4294967295 

sub PerformFileTransfer
...
pid = Shell("ftp -sftpcommands.txt >result.txt 2>result.txt", vbMaximizedFocus)
i = WaitForSingleObject(pid, INFINITE)
Все. Потом читаешь result.txt и смотришь на все что ftp.exe может сказать про свою жизнь тяжелую.
...
Рейтинг: 0 / 0
удаление файлов на ftp по маске с помощью утилиты ftp.exe
    #34580965
babken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Спасибо всем. Вопрос решен. Лучшим решением оказалось использование API.

С уважением,
...
Рейтинг: 0 / 0
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / удаление файлов на ftp по маске с помощью утилиты ftp.exe
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]