Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Private Sub XpB5_Click()
On Error GoTo oshibka
Dim FileNum As Integer
Dim txt As String
Dim ncftp As String
ncftp = "C:\Program Files\NcFTP\ncftpput.exe"
FileNum = FreeFile
txt = "@ECHO OFF" + vbCrLf
txt = txt + "set archive=" + """C:\obmen\archive\""" + vbCrLf
txt = txt + "set obmen=" + """C:\obmen\zayav\""" + vbCrLf
txt = txt + "set tempfld=" + """C:\obmen\temp\""" + vbCrLf
txt = txt + "set dd=%DATE:~0,2%" + vbCrLf
txt = txt + "set mm=%DATE:~3,2%" + vbCrLf
txt = txt + "set yyyy=%DATE:~8,2%" + vbCrLf
txt = txt + "set imya=%dd%%mm%%yyyy%" + vbCrLf
txt = txt + "IF NOT EXIST %obmen%zayav.dbf goto end" + vbCrLf
txt = txt + "copy %obmen%zayav.dbf %tempfld%lenina%imya%(1).dbf" + vbCrLf
txt = txt + "ECHO !!!!!ОТПРАВЛЯЮТСЯ ФАЙЛЫ!!!!!!!!!!!!ОТПРАВЛЯЮТСЯ ФАЙЛЫ!!!!!!" + vbCrLf
If Check1.Value =  1  Then
txt = txt + """" & ncftp & """ -F -u celitel -p echo. 91.210.0.0 /zayav C:\obmen\temp\lenina%imya%(1).dbf" + vbCrLf
End If
If Check2.Value =  1  Then
txt = txt + """" & ncftp & """ -F -u celitel -p echo. 91.205.0.0 /zayav C:\obmen\temp\lenina%imya%(1).dbf" + vbCrLf
End If
txt = txt + "If errorlevel 1 ECHO !!!!!ЗАЯВКА НЕ ОТПРАВЛЕНА ПРОВЕРЬТЕ ИНТЕРНЕТ!!!!!!!! & goto end2" + vbCrLf
txt = txt + "del %tempfld%*.* /q" + vbCrLf
txt = txt + "cls" + vbCrLf
txt = txt + "ECHO !!!ЗАКАЗ ОТПРАВЛЕН УСПЕШНО!!!!" + vbCrLf
txt = txt + "ECHO !!!СЕЙЧАС ЗАЯВКА БУДЕТ ДОБАВЛЕНА В АРХИВ!!!!" + vbCrLf
txt = txt + "ECHO !!!!!НАЖМИТЕ ЛЮБУЮ КНОПКУ!!!!" + vbCrLf
txt = txt + "pause" + vbCrLf
txt = txt + "copy %obmen%zayav.dbf %archive%os%imya%.dbf" + vbCrLf
txt = txt + "goto :EOF" + vbCrLf
txt = txt + ":end" + vbCrLf
txt = txt + "ECHO !!!!!НЕТ ЗАЯВКИ ДЛЯ ОТПРАВКИ!!!!!!" + vbCrLf
txt = txt + "pause" + vbCrLf
txt = txt + "goto :EOF" + vbCrLf
txt = txt + ":end2" + vbCrLf
txt = txt + "del %tempfld%*.* /q" + vbCrLf
txt = txt + "pause" + vbCrLf
txt = txt + "del c:\obmen\obmen.bat /q"
   
OutputStr$ = Space$(Len(txt)) ' ВНИМАНИЕ НА ЭТУ СТРОЧКУ
code& = CharToOem(txt, OutputStr$)  '
'Print code&: Print txt: Print OutputStr$
   
Open "c:\obmen\text.txt" For Output As FileNum
Print #FileNum, OutputStr$
Close #FileNum

FileCopy "c:\obmen\text.txt", "c:\obmen\obmen.bat"
Kill ("C:\obmen\text.txt")
'Shell "cmd /c C:\obmen\obmen.bat"

ShellExecute  0 , vbNullString, "C:\obmen\obmen.bat", _
      vbNullString, vbNullString, vbNormalFocus
 Exit Sub
oshibka:

message2 = MsgBox("НЕТ НАСТРОЕК", vbOKOnly, "ОШИБКА")
 Exit Sub
            
End Sub