Архивируем и отправляем по почте

[VBnovichok]

Привет всем,

Подскажите, по отдельности коды 1 и 2 работают, а вот вместе никак, в чем здесь фишка и почему не работает?

Код 1 - Архивирует все файлы из папки c:\temp\ и помещает в c:\temp000\

Код 2 - выбирает файлы из c:\temp000\ и отправляет каждый по отдельности вложением

Private Sub Form_Load()

'Код 1
Shell ("C:\Program Files\WinRar\rar.exe a -r -m5 -v450 c:\temp000\temp000.rar c:\temp\*.*"), 0

'Код 2
Dim MessageCtrl
Dim SessionCtrl
Dim F As String

Const P As String = "c:\temp000\"
F = Dir$(P & "temp000.part??.rar")
While Len(F) > 0

Set SessionCtrl = CreateObject("MSMAPI.MAPISession")
If Err.Number <> 0 Then
MsgBox "Error # " & CStr(Err.Number) & vbLf & Err.Description
Err.Clear
End If
Set MessageCtrl = CreateObject("MSMAPI.MAPIMessages")

SessionCtrl.DownloadMail = False
SessionCtrl.SignOn
MessageCtrl.SessionID = SessionCtrl.SessionID
MessageCtrl.Compose
MessageCtrl.RecipAddress = "user@domain.com"
MessageCtrl.MsgSubject = "Subject"
MessageCtrl.MsgNoteText = "Message body"
MessageCtrl.AttachmentPathName = P & F
MessageCtrl.Send False

F = Dir$
Wend
End
End Sub

Спасибо

[RayShade]

Код 1 запускает RAR. Тому нужно некоторое время чтобы отработать. Но Shell асинхронен, поэтому программа работатет дальше, а файлы, используемые в Код 2 еще не существуют.

[v-adix]

почему же. можно запустить приложение и ждать завершения выполнения. а RAR выполнит то, что надо и просто завершится. там в Help'е по моему подробное описание командной строки есть. надеюсь все знают, как ждать завершения приложения?
http://vb.astral.kiev.ua/winapi.htm#RunAndWait
http://vbgarage.narod.ru/is_All.htm#_9.Как_узнать,_когда

[RayShade]

Вопрос был "почему не работает". Ответ касается только приведенного кода. Когда Shell вызван таким образом, то ничего ждать программа не станет. Максимум чего она дождется - это момента, когда RAR загрузится и начнет работу.

[v-adix]

Вопрос был "почему не работает". Ответ касается только приведенного кода. Когда Shell вызван таким образом, то ничего ждать программа не станет. Максимум чего она дождется - это момента, когда RAR загрузится и начнет работу.

могли бы обьяснить человеку что к чему и хотябы помочь! а то нет:
"прога не работает потому что ты делаешь это не так".
хотябы обьяснили что надо вызывать shell указанным мной способом

[VBnovichok]

Cпасибо "v-adix" за поддержку
Попробую разобраться в приведенных тобою ссылках

P.S. Отнесемся с пониманием к моим начальным познаниям VB

[VBnovichok]

Нашел вариант:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()

'Код 1
Shell ("C:\Program Files\WinRar\rar.exe a -r -m5 -v450 c:\temp000\temp000.rar c:\temp\*.*"), 0

Sleep 20000 ' Пауза на 20 секунд

'Код 2
Dim MessageCtrl
Dim SessionCtrl
Dim F As String

Const P As String = "c:\temp000\"
F = Dir$(P & "temp000.part??.rar")
While Len(F) > 0

Set SessionCtrl = CreateObject("MSMAPI.MAPISession")
If Err.Number <> 0 Then
MsgBox "Error # " & CStr(Err.Number) & vbLf & Err.Description
Err.Clear
End If
Set MessageCtrl = CreateObject("MSMAPI.MAPIMessages")

SessionCtrl.DownloadMail = False
SessionCtrl.SignOn
MessageCtrl.SessionID = SessionCtrl.SessionID
MessageCtrl.Compose
MessageCtrl.RecipAddress = "user@domain.com"
MessageCtrl.MsgSubject = "Subject"
MessageCtrl.MsgNoteText = "Message body"
MessageCtrl.AttachmentPathName = P & F
MessageCtrl.Send False

F = Dir$
Wend
End
End Sub


Насколько это правильно? может быть есть более логичные варианты при которых все это бдет работать?


Спасибо.

[drronnie]

если файлов мало - сожмётся быстрее, чем за 20 сек.... остальное время будет просто ждать... если много файлов - то и в 20 сек не уложишься....

[VBnovichok]

Логично, согласен!
Поэтому и сомневаюсь.

Есть предложения?

[Dmitriy2003]

http://bbs.vbstreets.ru/viewtopic.php?t ... ngleobject

[v-adix]

Cпасибо "v-adix" за поддержку
Попробую разобраться в приведенных тобою ссылках

пожалуйста!

"спать" (sleep) кстати можно и без применения API функций. поставь на форму таймер, свойство enabled=false
далее,
Private Sub Timer1_Timer()
Timer1.Enabled=false
End Sub

далее ф-ция Sleep:

Private Sub Sleep(milliseconds as integer)
timer1.interval = milliseconds
timer1.enabled=true
while timer1.enabled=true
DoEvents
wend
end sub

я так всегда делаю. а можно, вообще не использовать Sleep. просто ждать пока WinRar не выгрузится. во время работы Rar'а твоя программа как бы "зависнет", а как только Rar завершит работу и выгрузится, то твоя программа продолжает свою работу. к этому времени заархивированные файлы уже будут созданы.
лучше делать так. неужели этого нет в ссылках которые я дал? вот же:
http://vb.astral.kiev.ua/winapi.htm#RunAndWait

а твой код будет выглядеть так:

Код: Выделить всё

Option Explicit

Const INFINITE = &HFFFF
'StartupInfo constants
Public Const STARTF_FORCEOFFFEEDBACK = &H80
Public Const STARTF_FORCEONFEEDBACK = &H40
Public Const STARTF_RUNFULLSCREEN = &H20
Public Const STARTF_USECOUNTCHARS = &H8
Public Const STARTF_USEFILLATTRIBUTE = &H10
Public Const STARTF_USEPOSITION = &H4
Public Const STARTF_USESHOWWINDOW = &H1
Public Const STARTF_USESIZE = &H2
Public Const STARTF_USESTDHANDLES = &H100
'ShowWindow constants
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10

Public Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type

Public Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type

Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

'
Public Function RunAndWait(ComLine As String, DefaultDir As String, ShowFlag As VbAppWinStyle) As Boolean
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    si.wShowWindow = ShowFlag
    si.dwFlags = STARTF_USESHOWWINDOW
    If CreateProcess(vbNullString, ComLine, ByVal 0&, ByVal 0&, False, 0, ByVal 0&, DefaultDir, si, pi) Then
        WaitForSingleObject pi.hProcess, INFINITE
        CloseHandle pi.hProcess
        RunAndWait = True
        Exit Function
    End If
    RunAndWait = False
End Function

Private Sub Form_Load()
'Код 1
RunAndWait "rar.exe a -r -m5 -v450 c:\temp000\temp000.rar c:\temp\*.*", "C:\Program Files\WinRar\", vbNormalFocus


'Код 2
Dim MessageCtrl
Dim SessionCtrl
Dim F As String

Const P As String = "c:\temp000\"
F = Dir$(P & "temp000.part??.rar")
While Len(F) > 0

Set SessionCtrl = CreateObject("MSMAPI.MAPISession")
If Err.Number <> 0 Then
MsgBox "Error # " & CStr(Err.Number) & vbLf & Err.Description
Err.Clear
End If
Set MessageCtrl = CreateObject("MSMAPI.MAPIMessages")

SessionCtrl.DownloadMail = False
SessionCtrl.SignOn
MessageCtrl.SessionID = SessionCtrl.SessionID
MessageCtrl.Compose
MessageCtrl.RecipAddress = "user@domain.com"
MessageCtrl.MsgSubject = "Subject"
MessageCtrl.MsgNoteText = "Message body"
MessageCtrl.AttachmentPathName = P & F
MessageCtrl.Send False

F = Dir$
Wend
End
End Sub


Вроде так должно работать. Извини, не проверял. если не заработает, ещё поковыряюсь