9
FILE_NAME   C:\Users\SlobodchikovIuS\AppData\Local\SAP\SAP GUI\tmp\ZFI_J_3RF_BUY_2014-100915.XLSM
MACROSNAME   'ZWWW_MACROS_100915.xls'!FillVariables
DEBUG_MODE   
WITHOUT_OLE   
PRINTDIALOG   
PROTECT   
DECIMAL_SEPARATOR   
CLOSE_FORM   
DELETE_FILE   
   00000   <DATE_TO>   S   1   31.12.2014
*   *   <DATE_FROM>   S   0   01.10.2014
*   *   <CONTR_NAME>   S   0    ОАО "ОАО"
*   *   <CONTR_INN_KPP>   S   0   654654654/1231321321
*   *   <ADD_NUM>   S   0   
*   *   <ADD_DATE>   S   0   
LINE   00001   <WRBTR_WRS_INV>   S   56845   RUB
*   *   <SELL_WO_VAT>   S   0   0.00
*   *   <SELL_VAT_18>   S   0   0.00
*   *   <SELL_VAT_10>   S   0   0.00
*   *   <SELL_SUM_18>   S   0   0.00
*   *   <SELL_SUM_10>   S   0   0.00
*   *   <SELL_SUM_0>   S   0   0.00
*   *   <SELL_RUB>   S   0   0.00
*   *   <SELL_CUR>   S   0   
*   *   <SELL_ACCEPT>   S   0   
*   *   <OPER_TYP>   S   0   '
*   *   <NUM>   S   0   0001
*   *   <NAME>   S   0   ООО "ООО"
*   *   <MWSKZ>   S   0   PC
*   *   <KSF_CORR>   S   0   
*   *   <KSF>   S   0   
*   *   <INV_CORR>   S   0   
*   *   <INV>   S   0   000984, 31.05.2014
*   *   <INN_KPP>   S   0   1321654/876514321
*   *   <GJAHR>   S   0   2014
*   *   <CURRENCY>   S   0   
*   *   <BUY_VAT_PAY>   S   0   
*   *   <BUY_VAT>   S   0   0.01
*   *   <BUY_SUM>   S   0   0.07
*   *   <BUY_CUSTOMS>   S   0   -
*   *   <BUY_ACC_DAT>   S   0   25.06.2014
*   *   <BELNR>   S   0   98412165418
*   *   <AGENT_INN_KPP>   S   0   -/-
*   *   <AGENT>   S   0   

Public Sub FillVariables(FileData As String, UseUnicode As String)
  Dim fs, f, _
      Ln As String, r As Range, Ofs As Range, _
      Ar() As String, I As Long, J As Long, Cnt As Long, _
      Value, QTable As QueryTable, RowsCount As Long, _
      MACROSNAME, ErrNumber, FldsInfo(1 To 300) As Variant, _
      OfsRowsCount As Long, NewRng As Range, OfsCount As Long, _
      CodePageTxt As Integer, FileNameTemplate As String, _
      NumParams As Integer, Param, _
      ResDialogPrint, _
      Sht As Worksheet, _
      Psw As String, _
      FILE_NAME As String, _
      WITHOUT_OLE As String, _
      MACROS_NAME As String, _
      DEBUG_MODE As String, _
      CLOSE_FORM As String, _
      PRINTDIALOG As String, _
      PROTECT_WB As String

  RowsCount = 1
 
  For I = 1 To 300
    FldsInfo(I) = Array(I, 2)
  Next
 
'  Set fs = CreateObject("Scripting.FileSystemObject")
  ErrNumber = 0
 
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
  End With

  Err.Clear
  ErrNumber = 0
 
  I = 0
  CodePageTxt = -2
  If UseUnicode = "X" Then
    CodePageTxt = -1
  End If

'  Set f = fs.OpenTextFile(FileData, 1, 0, CodePageTxt)
  Open FileData For Input As #1
 
'  NumParams = f.ReadLine
  Line Input #1, Ln
  NumParams = Ln
 
'  Do While Not f.AtEndOfStream And NumParams > 0
  Do While Not EOF(1) And NumParams > 0
    NumParams = NumParams - 1
   
'    Ln = f.ReadLine
    Line Input #1, Ln

    Param = Split(Ln, Chr(9))
    If UBound(Param) = 1 Then
      Select Case Param(0)
        Case "FILE_NAME"
          FILE_NAME = Param(1)
        Case "WITHOUT_OLE"
          WITHOUT_OLE = Param(1)
        Case "MACROSNAME"
          MACROS_NAME = Param(1)
        Case "DEBUG_MODE"
          DEBUG_MODE = Param(1)
        Case "CLOSE_FORM"
          CLOSE_FORM = Param(1)
        Case "PRINTDIALOG"
          PRINTDIALOG = Param(1)
        Case "PROTECT"
          PROTECT_WB = Param(1)
      End Select
    End If
  Loop
 
  If DEBUG_MODE = "X" Then
    Stop
  End If
 
  If WITHOUT_OLE = "X" And FILE_NAME <> "" Then
    Dim App As New Excel.Application
'    Dim App As Application
   
'    Set App = Application
    App.DisplayAlerts = False
    App.ScreenUpdating = False
    App.Workbooks.Open FILE_NAME
    App.ActiveWorkbook.Activate
  Else
    Set App = Application
  End If
 
  If DEBUG_MODE = "X" Then
    App.Visible = True
    App.ScreenUpdating = True
  End If
 
  Set r = App.Cells
 
'  Do While Not f.AtEndOfStream
  Do While Not EOF(1)
   
    I = 1 ''I + 1
   
'    Ln = f.ReadLine
    Line Input #1, Ln
   
'    ReDim Preserve Ar(1 To I) As t_Ar
    Ar = Split(Ln, Chr(9), 6, vbBinaryCompare)
    If Ar(4) > 0 Then
      Ar(4) = Ar(4) - 1
    End If
   
'    ErrNumber = 0
    On Error Resume Next
    If Ar(0) = "" Then
      Set r = App.Cells
      ErrNumber = Err.Number
    Else
      If Ar(0) <> "*" Then
        'At new VAR_NAME
         
        Set r = App.Range(Ar(0))
        ErrNumber = Err.Number
        RowsCount = r.Rows.Count
        OfsCount = RowsCount
       
        If ErrNumber = 0 And Ar(4) <> 0 Then
          r.Copy
          Set Ofs = r.Offset(RowsCount)
          Ofs.Resize(Ar(4) * RowsCount).Insert
          ErrNumber = Err.Number
        End If
      ElseIf Ar(1) <> "*" Then
        Set r = r.Offset(OfsCount).Resize(RowsCount)
        OfsCount = RowsCount
      End If
    End If
   
'    OfsCount = RowsCount
   
    If ErrNumber = 0 Then
      If Ar(2) = "" Then
        If Ar(3) = "" Or Ar(3) = "S" Then
          Set Ofs = r.Cells(1, 1)
          Ofs.Value = Ar(5)
          Ofs.TextToColumns DataType:=xlDelimited
        ElseIf Ar(3) = "V" Then
          Set Ofs = App.Range(Ar(5))
          OfsRowsCount = Ofs.Rows.Count
          If OfsRowsCount > RowsCount Then
            OfsCount = OfsRowsCount
            Set NewRng = r.Offset(RowsCount)
            NewRng.Resize(OfsRowsCount - RowsCount).Insert
          ElseIf OfsRowsCount < RowsCount Then
            OfsCount = OfsRowsCount
            Set NewRng = r.Offset(OfsRowsCount)
            NewRng.Resize(RowsCount - OfsRowsCount).Delete
          End If
          Ofs.Copy r
          If OfsCount <> RowsCount Then
            Set r = r.Resize(OfsCount)
          End If
        ElseIf Ar(3) = "M" Then
          Err.Clear
          MACROSNAME = "'" + App.ActiveWorkbook.Name + "'" + "!" + Ar(5)
          App.Run MACROSNAME, r
          If Err.Number <> 0 Then
            App.Run MACROSNAME
          End If
        End If
      Else
        If Ar(3) = "S" Then 'or InStr(1, Ar(5), Chr(9)) = 0 Then
          Ln = Ar(5)
          r.Replace Ar(2), Ln, xlPart, xlByRows, False
        ElseIf Ar(1) <> "*" And Ar(3) = "T" Then
          Set Ofs = r.Find(Ar(2))
          Set QTable = r.Worksheet.QueryTables.Add("TEXT;" + Ar(5), Ofs)
          QTable.AdjustColumnWidth = False
          QTable.RefreshStyle = False
          QTable.Refresh
          QTable.Delete
          fs.DeleteFile Ar(5) 'Value(1)
        ElseIf Ar(3) = "R" Then
          Set Ofs = r.Find(Ar(2))
          Ofs.Value = Ar(5)
          If Ofs.NumberFormat = "@" Then
            Ofs.TextToColumns DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, FieldInfo:=FldsInfo
          Else
            Ofs.TextToColumns DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone
          End If
        End If
      End If
     
      If Ar(3) = "D" Then
        App.Range(Ar(0)).Delete
      End If
    End If
   
    Err.Clear
  Loop
 
  Close #1
 
  If WITHOUT_OLE = "X" Then
    App.DisplayAlerts = True
    App.ScreenUpdating = True
   
    If PROTECT_WB = "X" Then
      Psw = Time
      For Each Sht In App.Worksheets
        Sht.Protect Psw, True, True, True
      Next
    End If
 
    App.ActiveWorkbook.Save
   
    If CLOSE_FORM <> "X" Then
      With App
        .DisplayAlerts = True
        .ScreenUpdating = True
        .Visible = True
      End With
    End If
 
    If PRINTDIALOG = "X" Then
      ResDialogPrint = App.Dialogs.Item(xlDialogPrint).Show
    End If
 
    If CLOSE_FORM = "X" Or _
       PRINTDIALOG = "X" Then
      App.Quit
    End If
  End If
End Sub