none
как добавить в Excell RRS feed

  • Вопрос

  • подскажите, как добавить в файл *.xls дополнительную запись, т.е. следующую строчку, чтоб каждый раз при запуске скрипта он изменял файл *.xls добавлением записи, а не создавал новый вот скрипт который должен вести лог:
    On Error Resume Next 
    Dim adsinfo, ThisComp, oUser, fso, tf
    Set adsinfo = CreateObject("adsysteminfo") 
    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName) 
    Set oUser = GetObject("LDAP://" & adsinfo.UserName) 
    if Lcase(ThisComp.cn)="ts" or Lcase(ThisComp.cn)="ts1" then
    wscript.echo "Hello"
    wscript.quit
    end If
    dtmDate = Date
    strMonth = Month(Date)
    strDay = Day(Date)
    strYear = Right(Year(Date),2)
    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    Set objWorkbook = objExcel.Workbooks.Add
    objExcel.Workbooks.Add
    objExcel.Cells(1, 1).Value = oUser.cn
    objExcel.Cells(1, 2).Value = ThisComp.cn
    objExcel.Cells(1, 3).Value = "Logged off: " +  " " + CStr(Now)
    objExcel.ActiveWorkbook.SaveCopyAs(strFileName)
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Close
    objExcel.Quit
    17 декабря 2011 г. 6:53

Ответы

  • Вот мои наброски:

    On Error Resume Next
    Dim adsinfo, ThisComp, oUser, fso, tf
    Set adsinfo = CreateObject("adsysteminfo")
    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName)
    Set oUser = GetObject("LDAP://" & adsinfo.UserName)
    If Lcase(ThisComp.cn)="ts" or Lcase(ThisComp.cn)="ts1" then
       wscript.echo "Hello"
       wscript.quit
    end If
    dtmDate = Date
    strMonth = Month(Date)
    strDay = Day(Date)
    strYear = Right(Year(Date),2)
    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If (objFSO.FileExists(strFileName) = false) Then
           Set objWorkbook = objExcel.Workbooks.Add
           objExcel.Cells(1, 1).Value = "User"
           objExcel.Cells(1, 2).Value = "Computer"
           objExcel.Cells(1, 3).Value = "LOgged off"
           objExcel.ActiveWorkbook.SaveCopyAs(strFileName)
           objExcel.DisplayAlerts = False
           objExcel.Workbooks.Close
           objExcel.Quit
    End If

    Const xlCellTypeLastCell = 11

    Set objWorkbook = objExcel.Workbooks.Open(strFileName)
    Set objWorksheet = objWorkbook.Worksheets(1)
    objWorksheet.Activate
    Set objRange = objWorksheet.UsedRange
    objRange.SpecialCells(xlCellTypeLastCell).Activate
    intNewRow = objExcel.ActiveCell.Row + 1

    objExcel.Cells(intNewRow, 1).Value = oUser.cn
    objExcel.Cells(intNewRow, 2).Value = ThisComp.cn
    objExcel.Cells(intNewRow, 3).Value = "Logged off: " +  " " + CStr(Now)
    objExcel.ActiveWorkbook.Save
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Close
    objExcel.Quit

     


     

     

     

     

    • Изменено Evgenii Alekseev 17 декабря 2011 г. 8:44
    • Помечено в качестве ответа KazunEditor 18 декабря 2011 г. 12:02
    17 декабря 2011 г. 8:36

Все ответы

  • Я думаю вам поможет эта статья: http://blogs.technet.com/b/heyscriptingguy/archive/2006/02/15/how-can-i-determine-the-last-row-in-an-excel-spreadsheet.aspx

    только активная строка перескакивает и все или может я что тоне то делаю:

    On Error Resume Next 
    Dim adsinfo, ThisComp, oUser, fso, tf
    Set adsinfo = CreateObject("adsysteminfo") 
    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName) 
    Set oUser = GetObject("LDAP://" & adsinfo.UserName) 
    if Lcase(ThisComp.cn)="ts" or Lcase(ThisComp.cn)="ts1" then
    wscript.echo "Hello"
    wscript.quit
    end If
    dtmDate = Date
    strMonth = Month(Date)
    strDay = Day(Date)
    strYear = Right(Year(Date),2)
    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    Set objWorkbook = objExcel.Workbooks.Add
    objExcel.Workbooks.Add
    objExcel.Cells(1, 1).Value = oUser.cn
    objExcel.Cells(1, 2).Value = ThisComp.cn
    objExcel.Cells(1, 3).Value = "Logged off: " +  " " + CStr(Now)
    Const xlCellTypeLastCell = 11
    Set objRange = objWorksheet.UsedRange
    objRange.SpecialCells(xlCellTypeLastCell).Activate
    intNewRow = objExcel.ActiveCell.Row + 1
    strNewCell = "A" &  intNewRow
    objExcel.Range(strNewCell).Activate
    objExcel.ActiveWorkbook.SaveCopyAs(strFileName)
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Close
    objExcel.Quit

    17 декабря 2011 г. 8:11
  • Или с этим скриптом помогите, здесь выгружается в *.csv, все нормально проходит, добавляется значение в каждой следующей строчке, но как мне разделить по ячейкам? как в *.xls не получается

    On Error Resume Next 

    Dim adsinfo, ThisComp, oUser, fso, tf

     

    Set adsinfo = CreateObject("adsysteminfo") 

    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName) 

    Set oUser = GetObject("LDAP://" & adsinfo.UserName) 

    if Lcase(ThisComp.cn)="ts-mims" or Lcase(ThisComp.cn)="ts-mims1" then

    wscript.echo "Hello"

    wscript.quit

    end If

     

    dtmDate = Date

    strMonth = Month(Date)

    strDay = Day(Date)

    strYear = Right(Year(Date),2)

    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".csv"

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set tf = fso.OpenTextFile(strFileName, 8, True)

    fso.SaveAs(strFileName)

    tf.WriteLine(vbCrLf & oUser.cn & " | " & + ThisComp.cn + " | >>Logged off: " +  " " + CStr(Now) & vbTab)

    17 декабря 2011 г. 8:23
  • Вот мои наброски:

    On Error Resume Next
    Dim adsinfo, ThisComp, oUser, fso, tf
    Set adsinfo = CreateObject("adsysteminfo")
    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName)
    Set oUser = GetObject("LDAP://" & adsinfo.UserName)
    If Lcase(ThisComp.cn)="ts" or Lcase(ThisComp.cn)="ts1" then
       wscript.echo "Hello"
       wscript.quit
    end If
    dtmDate = Date
    strMonth = Month(Date)
    strDay = Day(Date)
    strYear = Right(Year(Date),2)
    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If (objFSO.FileExists(strFileName) = false) Then
           Set objWorkbook = objExcel.Workbooks.Add
           objExcel.Cells(1, 1).Value = "User"
           objExcel.Cells(1, 2).Value = "Computer"
           objExcel.Cells(1, 3).Value = "LOgged off"
           objExcel.ActiveWorkbook.SaveCopyAs(strFileName)
           objExcel.DisplayAlerts = False
           objExcel.Workbooks.Close
           objExcel.Quit
    End If

    Const xlCellTypeLastCell = 11

    Set objWorkbook = objExcel.Workbooks.Open(strFileName)
    Set objWorksheet = objWorkbook.Worksheets(1)
    objWorksheet.Activate
    Set objRange = objWorksheet.UsedRange
    objRange.SpecialCells(xlCellTypeLastCell).Activate
    intNewRow = objExcel.ActiveCell.Row + 1

    objExcel.Cells(intNewRow, 1).Value = oUser.cn
    objExcel.Cells(intNewRow, 2).Value = ThisComp.cn
    objExcel.Cells(intNewRow, 3).Value = "Logged off: " +  " " + CStr(Now)
    objExcel.ActiveWorkbook.Save
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Close
    objExcel.Quit

     


     

     

     

     

    • Изменено Evgenii Alekseev 17 декабря 2011 г. 8:44
    • Помечено в качестве ответа KazunEditor 18 декабря 2011 г. 12:02
    17 декабря 2011 г. 8:36
  • Вот мои наброски:

    On Error Resume Next
    Dim adsinfo, ThisComp, oUser, fso, tf
    Set adsinfo = CreateObject("adsysteminfo")
    Set ThisComp = GetObject("LDAP://" & adsinfo.ComputerName)
    Set oUser = GetObject("LDAP://" & adsinfo.UserName)
    If Lcase(ThisComp.cn)="ts" or Lcase(ThisComp.cn)="ts1" then
       wscript.echo "Hello"
       wscript.quit
    end If
    dtmDate = Date
    strMonth = Month(Date)
    strDay = Day(Date)
    strYear = Right(Year(Date),2)
    strFileName = "D:\" & strDay & "-" & strMonth & "-" & strYear & ".xls"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If (objFSO.FileExists(strFileName) = false) Then
           Set objWorkbook = objExcel.Workbooks.Add
           objExcel.Cells(1, 1).Value = "User"
           objExcel.Cells(1, 2).Value = "Computer"
           objExcel.Cells(1, 3).Value = "LOgged off"
           objExcel.ActiveWorkbook.SaveCopyAs(strFileName)
           objExcel.DisplayAlerts = False
           objExcel.Workbooks.Close
           objExcel.Quit
    End If

    Const xlCellTypeLastCell = 11

    Set objWorkbook = objExcel.Workbooks.Open(strFileName)
    Set objWorksheet = objWorkbook.Worksheets(1)
    objWorksheet.Activate
    Set objRange = objWorksheet.UsedRange
    objRange.SpecialCells(xlCellTypeLastCell).Activate
    intNewRow = objExcel.ActiveCell.Row + 1

    objExcel.Cells(intNewRow, 1).Value = oUser.cn
    objExcel.Cells(intNewRow, 2).Value = ThisComp.cn
    objExcel.Cells(intNewRow, 3).Value = "Logged off: " +  " " + CStr(Now)
    objExcel.ActiveWorkbook.Save
    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Close
    objExcel.Quit

     

     

     

     

     

    спасибо, все получилось, тему можно закрывать
    18 декабря 2011 г. 7:33