Option Explicit
WScript.Echo "Selected file: " & ChooseFile( )
Function ChooseFile( )
' Select File dialog based on a script by Mayayana
' Known issues:
' * Tree view always opens Desktop folder
' * In Win7/IE8 only the file NAME is returned correctly, the path returned will always be C:\fakepath\
' * If a shortcut to a file is selected, the name of that FILE will be returned, not the shortcut's
On Error Resume Next
Dim objIE, strSelected
ChooseFile = ""
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.visible = False
objIE.Navigate( "about:blank" )
Do Until objIE.ReadyState = 4
Loop
objIE.Document.Write ""
With objIE.Document.all.FileSelect
.focus
.click
strSelected = .value
End With
objIE.Quit
Set objIE = Nothing
ChooseFile = strSelected
End Function
'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