Option Explicit
Dim objFSO, objExcel, OutStream, objDialog, intResult
Dim wb, sh, iLastRow, a, i
Dim MyPath, fname
'# Диалог открытия файла
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Input Files|*.xls*|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = ""
intResult = objDialog.ShowOpen
If intResult = 0 Then
WScript.Quit
End If
ActivateExcel
Set wb = objExcel.Workbooks.Open(objDialog.Filename)
Set sh = wb.Worksheets.Item(1)
MyPath = Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName)) - (Len(WScript.ScriptName)))
iLastRow = sh.Cells(sh.Rows.Count, 1).End(-4162).Row
a = sh.Range(sh.Cells(1, 1), sh.Cells(iLastRow, 2)).Value
fname = Left(wb.Name, Len(wb.Name) - 4)
wb.Close False
Set objExcel = Nothing
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
objFSO.DeleteFile (MyPath & fname & ".htm")
On Error GoTo 0
Set OutStream = objFSO.OpenTextFile(MyPath & fname & ".htm", 8, True)
OutStream.Write "" _
& vbNewLine & _
"" _
& vbNewLine & _
"" _
& vbNewLine & _
"" _
& vbNewLine & _
"Счет N " & split(a(1,1))(0) & " от " & split(a(1,1))(1) & "" _
& vbNewLine & _
"" _
& vbNewLine & _
"" _
& vbNewLine & _
"| N | " _
& vbNewLine & _
"Наименование товара | " _
& vbNewLine & _
"Ед. изм. | " _
& vbNewLine & _
"Кол-во | " _
& vbNewLine & _
"
" _
& vbNewLine
For i = 1 To UBound(a)
OutStream.Write "" & vbNewLine
OutStream.Write "| " & i & " | " & vbNewLine
OutStream.Write "" & a(i, 1) & " | " & vbNewLine
OutStream.Write " | " & vbNewLine
OutStream.Write "" & a(i, 2) & " | " & vbNewLine
OutStream.Write "
" & vbNewLine
Next
Erase a
OutStream.Write "
" & vbNewLine & "" & vbNewLine & ""
OutStream.Close
Set OutStream = Nothing
Set objFSO = Nothing
Private Function ActivateExcel()
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'True
End If
End Function