Не запускается файл, если в его пути содержится кириллица

 Dim intFreeFile as Integer, intRetCodes as Integer
 
 intFreeFile  = freefile 
 Open "runScript.cmd" for output as intFreeFile 
    Print #intFreeFile, "@Echo off"
    Print #intFreeFile, chr (34)  & app.path & "\Progs.exe" & chr (34)
 Close intFreeFile 
 
  intRetCodes = Shell(chr (34)  & app.path & "\runScript.cmd" & chr (34),vbNormalFocus)

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
 
Dim intFreeFile As Integer, intRetCodes As Integer
Dim str    As String
 
intFreeFile = FreeFile
Open "runScript.cmd" For Output As intFreeFile
   Print #intFreeFile, "@Echo off"
   str = Chr(34) & App.Path & "\Progs.exe" & Chr(34)
   CharToOem str, str
   Print #intFreeFile, str
Close intFreeFile
 
intRetCodes = Shell(Chr(34) & App.Path & "\runScript.cmd" & Chr(34), vbNormalFocus)

Dim intFreeFile as Integer, intRetCodes as Integer
 
 intFreeFile  = freefile 
 Open "runScript.cmd" for output as intFreeFile 
    Print #intFreeFile, "@Echo off"
    Print #intFreeFile, chr (34)  & app.path & "\Progs.exe" & chr (34)
 Close intFreeFile 
 
 
Dim FullName as String
FullName = "runScript.cmd"
Dim txt as String
 
With CreateObject("ADODB.Stream")
    .Type = 2
    .Charset = "windows-1251"
    .Open
    .LoadFromFile FullName
    txt = .ReadText()
    .Close
 
    .Charset = "cp866"
    .Open
    .WriteText (txt)
    .SaveToFile FullName, 2
    .Close
End with
 
intRetCodes = Shell(chr (34)  & app.path & "\runScript.cmd" & chr (34),vbNormalFocus)

Option Explicit
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameW" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal cchBuffer As Long) As Long
 
Const MAX_PATH As Long = 260&
 
Private Sub Form_Load()
    Dim intFreeFile As Integer, intRetCodes As Integer, str    As String
 
    intFreeFile = FreeFile
    Open "runScript.cmd" For Output As intFreeFile
        Print #intFreeFile, "@Echo off"
        str = Chr(34) & App.Path & "\Progs.exe" & Chr(34)
        Print #intFreeFile, PathToDOS(str)
    Close intFreeFile
    
    intRetCodes = Shell(Chr(34) & App.Path & "\runScript.cmd" & Chr(34), vbNormalFocus)
End Sub
 
Public Function PathToDOS(Path As String)
    On Error GoTo ErrorHandler:
    Dim AltName         As String
    Dim SizeOfAltName   As Long
    
    AltName = Space$(MAX_PATH + 1&)
    SizeOfAltName = GetShortPathName(StrPtr(Path), StrPtr(AltName), MAX_PATH + 1&)
    If SizeOfAltName <> 0& Then
        AltName = Left$(AltName, SizeOfAltName)
        If StrComp(AltName, Path, 1) <> 0& Then PathToDOS = AltName
    End If
    Exit Function
ErrorHandler:
End Function

Const MAX_PATH      As Long = 260&
 
Private Declare Function GetModuleFileName Lib "kernel32.dll" Alias "GetModuleFileNameW" (ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
 
Public Function AppFullPathW() As String
    Static ProcPath As String
    Dim cnt         As Long
 
    If Len(ProcPath) <> 0 Then AppFullPathW = ProcPath: Exit Function
    'If inIDE Then AppFullPathW = App.Path & "\" & App.EXEName: Exit Function
 
    ProcPath = String$(MAX_PATH, vbNullChar)
    cnt = GetModuleFileName(0&, StrPtr(ProcPath), Len(ProcPath)) 'hproc can be 0 (mean - current process)
    
    If cnt = MAX_PATH Then 'Path > MAX_PATH -> realloc
        ProcPath = String$(32767&, vbNullChar)
        cnt = GetModuleFileName(0&, StrPtr(ProcPath), Len(ProcPath))
    End If
    If cnt = 0 Then                          'clear path
        ProcPath = App.Path & "\" & App.EXEName
    Else
        ProcPath = Left$(ProcPath, cnt)
        If StrComp("\SystemRoot\", Left$(ProcPath, 12), 1) = 0 Then ProcPath = Environ("SystemRoot") & Mid$(ProcPath, 12)
        If "\??\" = Left$(ProcPath, 4) Then ProcPath = Mid$(ProcPath, 5)
    End If
    AppFullPathW = ProcPath
End Function

Option Explicit
 
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
 
Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
 
Private Declare Function CreateProcessW Lib "kernel32.dll" (ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoW" (lpStartupInfo As STARTUPINFO)
 
Private Sub Form_Load()
    ProcessRun App.Path & "\HijackThis.exe"
    Unload Me
End Sub
 
Public Function ProcessRun(FilePath As String) As Boolean
    On Error GoTo ErrorHandler
    
    Dim si          As STARTUPINFO
    Dim pi          As PROCESS_INFORMATION
    
    GetStartupInfo si                                   ' клонируем структуру текущего процесса
    
    If CreateProcessW(StrPtr(FilePath), _
                        0&, _
                        ByVal 0&, _
                        ByVal 0&, _
                        False, _
                        0&, _
                        0&, _
                        0&, _
                        si, _
                        pi) Then
        ProcessRun = True
    Else
        Err.Raise 51
    End If
    
    If pi.hThread <> 0 Then CloseHandle pi.hThread
    If pi.hProcess <> 0 Then CloseHandle pi.hProcess
    Exit Function
ErrorHandler:
    Debug.Print "LastDllErr: " & Err.LastDllError
End Function