none
Adding additional lines into an excel spreadsheet with VBscript

    Question

  • I am trying to add information into an excell spreadsheet.  Apparently something is wrong with the last_row line.

     

    Sub OutputExcel(ByVal location, ByVal strArray)
    	Dim objExcel
    
    	Set objExcel = CreateObject("Excel.Application")
    
    	strPathExcel = "Z:\files\DesktopLocation.xls"
    	objExcel.Workbooks.open (strPathExcel)
    
    
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    	Select Case location
     	 Case "Default"
     	 	strWorksheet = "Default"
     	 Case "Locked"
      	strWorksheet = "Locked Down"
     	 Case "Other"
     		strWorksheet = "Other"
    	End Select	
    
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets.Item(strWorksheet)
    	last_row = objSheet.Range("A" & .Rows.Count).End(xlUp).Row
    	intIndex = last_row
    
    	For i = 0 To UBound(strArray)
    		objSheet.Cells(1, iniIndex).Value = strArray(i,0)
    		objSheet.Cells(2, intIndex).Value = strArray(i,1)
    		objSheet.Cells(3, intIndex).Value = strArray(i,2)
    		objSheet.Cells(4, intIndex).Value = strArray(i,3)
    		intIndex = intIndex +1
    	Next
    
    	' Save the spreadsheet and close the workbook.
    	' Specify Excel7 File Format.
    	objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7
    	objExcel.ActiveWorkbook.Close
    	' Quit Excel.
    	objExcel.Application.Quit
    
    	' Clean Up
    	Set objSheet = Nothing
    	Set objExcel = Nothing
    
    End Sub

    Wirrel
    Monday, October 25, 2010 1:30 PM

Answers

  • If that is the case, you could move the Excel file creation to the main script. You would use FSO to check if the file for the path you constructed exists. If it exists, you would just open it, and if it doesn''t exist you would create it, naming the worksheets appropriately. Once you get the reference to the workbook you want to write data to, you would just pass a reference to one of the worksheets to the OutputExcel sub. Here is an example:

     

    Const xlExcel7 = 39
    
    Set objFso = CreateObject("Scripting.FileSystemObject") 
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = true
    
    strPathExcel = "C:\Scripts\"
    strFile = "DesktopLocation"
    strYear = Right(Year(Date),2)
    strDay = Day(Date)
    strMonth = Month(Date)
    
    strSaveFile = strPathExcel & strFile & "-" & strYear & _
      "-" & strMonth & "-" & strDay & ".xls"
    
    If objFso.FileExists(strSaveFile) Then
      Set objWorkbook = objExcel.Workbooks.Open(strSaveFile)
    Else
      Set objWorkbook = objExcel.Workbooks.Add
      objWorkbook.Sheets(1).Name = "Default"
      objWorkbook.Sheets(2).Name = "Locked Down"
      objWorkbook.Sheets(3).Name = "Other"
      objWorkbook.SaveAs strSaveFile, xlExcel7
    End If
    
    arrSample = Array("a, b, c, d")
    
    OutputExcel "Default", arrSample, objWorkbook.Sheets("Default")
    OutputExcel "Locked Down", arrSample, objWorkbook.Sheets("Locked Down")
    OutputExcel "Other", arrSample, objWorkbook.Sheets("Other")
    
    objWorkbook.Save
    objWorkbook.Close
    objExcel.Quit
    
    
    
    Sub OutputExcel(ByVal location, ByVal strArray, ByRef objSheet)
      
      ' Add data to the sheet
      objSheet.Cells(1, 1) = location & now
      ' Save the workbook
      objSheet.Parent.Save
      
    End Sub
    
    
    
    
    

    Uros Calakovic
    Tuesday, October 26, 2010 6:27 PM
    Moderator

All replies

  • Just a quick glance, but, yes, this line has problems:

    last_row = objSheet.Range("A" & .Rows.Count).End(xlUp).Row
    

    For one thing, the constant xlUp probably needs to be assigned. But for sure ".Rows.Count" won't work unless you have a With block, which you do not. I assume it should be "objSheet.Range("A" & objSheet.Rows.Count). Also, do you have rows and columns reversed? In objSheet.Cells(1, intIndex) the 1 is the row number and intIndex is the column number.

    Richard Mueller


    MVP ADSI
    Monday, October 25, 2010 3:24 PM
    Moderator
  • In addition to Richard's reply, please see the inline comments:

     

    Sub OutputExcel(ByVal location, ByVal strArray)
    	
    	Dim objExcel
    	
     ' Should declare Excel constants before using them
     Const xlUp = -4162 
     Const xlExcel7 = 39
     
    	Set objExcel = CreateObject("Excel.Application")
    	strPathExcel = "C:\Scripts\DesktopLocation.xls"
    	objExcel.Workbooks.open (strPathExcel)
    
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    	
    	Select Case location
     	 Case "Default"
     	 	strWorksheet = "Default"
     	 Case "Locked"
     	strWorksheet = "Locked Down"
     	 Case "Other"
     		strWorksheet = "Other"
    	End Select	
    
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets.Item(strWorksheet)
    	' .Rows.Count should belong to a Worksheet
    	last_row = objSheet.Range("A" & objSheet.Rows.Count).End(xlUp).Row
    	
    	' using last_row will overwrite the last used row
    	' to write in the next empty row, use last_row + 1
    	intIndex = last_row
    
    	For i = 0 To UBound(strArray)
    	 ' typo, iniIndex should be intIndex
    	 ' intIndex is a row index, but you use it for columns
    		objSheet.Cells(intIndex, 1).Value = strArray(i,0)
    		objSheet.Cells(intIndex, 2).Value = strArray(i,1)
    		objSheet.Cells(intIndex, 3).Value = strArray(i,2)
    		objSheet.Cells(intIndex, 4).Value = strArray(i,3)
    		intIndex = intIndex +1
    	Next
    
    	' Save the spreadsheet and close the workbook.
    	' Specify Excel7 File Format.
    	
    	' strExcelPath should probably be strPathExcel
    	' If you use SaveAs with a file name that exists,
    	' you will get a confirmation dialog
    	' If you want to overwrite the existing file
    	' you can use Application.DisplayAlerts = False
    	objExcel.DisplayAlerts = False
    	objExcel.ActiveWorkbook.SaveAs strPathExcel, xlExcel7
    	objExcel.ActiveWorkbook.Close
    	' Quit Excel.
    	objExcel.Application.Quit
    
    	' Clean Up
    	Set objSheet = Nothing
    	Set objExcel = Nothing
    
    End Sub
    

    Uros Calakovic
    • Edited by AnonimistaModerator Monday, October 25, 2010 3:40 PM edited code
    • Marked as answer by JeffC72 Tuesday, October 26, 2010 3:37 PM
    • Unmarked as answer by JeffC72 Tuesday, October 26, 2010 4:57 PM
    Monday, October 25, 2010 3:38 PM
    Moderator
  • Thank you.  Thats what I get for looking at examples of VBA and trying to convert it to vbscript.  Now to work on the next subroutine that will create a sheet with the totals from each of the three locations.  I am thinking I can use this line to get the total lines for each sheet last_row = objSheet.Range("A" & objSheet.Rows.Count).End(xlUp).Row and subtract one for the header line. 
    Wirrel
    Monday, October 25, 2010 4:44 PM
  • Ok while i got that to work I have come across a logic error in that the file basically needs to be created by the script.  Once it is created then the sub routine that adds the data will run.  But I am trying to figure out the best way to do this in my script.  Each time the script is run it should gather the data, create the excell file and populate the data in the excell file.  I am adding my entire code as it is right now for suggestions on how i can make it do these things and also perhaps clean it up a little if there is a "better" way to do something.

    Dim oFs
    Dim oFolder
    Dim oFile 
    Dim strPath, strCurrentLine
    Dim arrTxtArray
    Dim arreDefaultLocation(0,3)
    Dim arreLockedLocation(0,3)
    Dim arreOtherLocation(0,3)
    Dim searchString
    Dim intSize
    
    Const ForReading = 1
    intSize = 0
    searchString = ","
    i = 0
    j = 0
    k = 0
    sString1 = "c:\windows\system32\config\systemprofile\desktop"
    sString2 = "c:\desktop"
    strPath = "\\macduhpxnappx01\logtrack$\DesktopLocation"
    arrTxtArray = Array()
    
    
    Set oFs = CreateObject("Scripting.FileSystemObject")
    
    If oFs.FolderExists(strPath) Then
      Set oFolder = oFs.GetFolder(strPath)
      For Each oFile In oFolder.Files
    		Set objFile = oFs.OpenTextFile(oFile, ForReading)
    		Do Until objFile.AtEndOfStream
    			strCurrentLine = objFile.ReadLine
    			arrTxtArray = Split(strCurrentLine, ",")
    		Loop
    		objFile.Close
    		strDesktop = arrTxtArray(2)
    	
    		Select Case LCase(Trim(strDesktop))
    		 Case sString1
    		 	ReDim Preserve arrDefaultLocation(i,3)
    		 		arrDefaultLocation(i,0) = arrTxtArray(0)
    		 		arrDefaultLocation(i,1) = arrTxtArray(1)
    		 		arrDefaultLocation(i,2) = arrTxtArray(2)
    		 		arrDefaultLocation(i,3) = CheckGroup(arrTxtArray(0))
    		 		i = i + 1
    		 Case sString2
    		 	
    		 	ReDim Preserve arrLockedLocation(j,3)
    		 		arrLockedLocation(j,0) = arrTxtArray(0)
    		 		arrLockedLocation(j,1) = arrTxtArray(1)
    		 		arrLockedLocation(j,2) = arrTxtArray(2)
    		 		arrLockedLocation(j,3) = CheckGroup(arrTxtArray(0))
    		 		j = j + 1
    		 Case Else
    		 ReDim Preserve arrOtherLocation(k,3)
    		 		arrOtherLocation(k,0) = arrTxtArray(0)
    		 		arrOtherLocation(k,1) = arrTxtArray(1)
    		 		arrOtherLocation(k,2) = arrTxtArray(2)
    		 		arrOtherLocation(k,3) = CheckGroup(arrTxtArray(0))
    		 		k = k + 1
    		 End Select
      Next
    End If
    
    arrSheet = Array("Default","Locked","Other")
    sArray = arrDefaultLocation
    location = arrSheet(0)
    Call OutputExcel(location, sArray)
    sArray = arrLockedLocation
    location = arrSheet(1)
    Call OutputExcel(location, sArray)
    sArray = arrOtherLocation
    location = arrSheet(2)
    Call OutputExcel(location, sArray)
    
    
    Sub OutputExcel(ByVal location, ByVal strArray)
    	Dim objExcel
    	
    	Const xlUp = -4162 
      Const xlExcel7 = 39
      
    	Set objExcel = CreateObject("Excel.Application")
    	
    	' Create a new workbook.
    	objExcel.Workbooks.Add
    
    
    	strPathExcel = "Z:\files\"
    	strFile = "DesktopLocation"
    	strYear = Right(Year(Date),2)
    	strDay = Day(Date)
    	strMonth = Month(Date)
    	strSaveFile = strPathExcel & strFile & "-" & strYear & "-" & strMonth & "-" & strDay & ".xls"
    	objExcel.Workbooks.open (strPathExcel & strFile & ".xls")
    
    	
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    	Select Case location
     	 Case "Default"
     	 	strWorksheet = "Default"
     	 Case "Locked"
      	strWorksheet = "Locked Down"
     	 Case "Other"
     		strWorksheet = "Other"
    	End Select	
    	
    	
    	Set objSheet = objExcel.ActiveWorkbook.Worksheets.Item(strWorksheet)
    	last_row = objSheet.Range("A" & objSheet.Rows.Count).End(xlUp).Row
    	intIndex = last_row +1
    
    	For i = 0 To UBound(strArray)
    		objSheet.Cells(intIndex, 1).Value = strArray(i,0)
    		objSheet.Cells(intIndex, 2).Value = strArray(i,1)
    		objSheet.Cells(intIndex, 3).Value = strArray(i,2)
    		objSheet.Cells(intIndex, 4).Value = strArray(i,3)
    		intIndex = intIndex +1
    	Next
    
    	' Save the spreadsheet and close the workbook.
    	' Specify Excel7 File Format.
    	objExcel.DisplayAlerts = False
    	objExcel.ActiveWorkbook.SaveAs strSaveFile, xlExcel7
    	objExcel.ActiveWorkbook.Close
    	' Quit Excel.
    	objExcel.Application.Quit
    
    	' Clean Up
    	Set objSheet = Nothing
    	Set objExcel = Nothing
    
    End Sub
    
    
    Function CheckGroup(username)
    ' Constants for the NameTranslate object.
    Const ADS_NAME_INITTYPE_GC = 3
    Const ADS_NAME_TYPE_NT4 = 3
    Const ADS_NAME_TYPE_1779 = 1
    
    strDomain = "Usocom"
    strGroup = "CN=XPtestgroup,OU=Software Control,OU=Security Global Groups,OU=Domain Groups,DC=socom,DC=mil"
    
    ' Specify the NetBIOS name of the domain.
    strNetBIOSDomain = strDomain
    
    ' Specify the NT name of the user.
    strNTName = username
    
    ' Use the NameTranslate object to convert the NT user name to the
    ' Distinguished Name required for the LDAP provider.
    Set objTrans = CreateObject("NameTranslate")
    ' Initialize NameTranslate by locating the Global Catalog.
    objTrans.Init ADS_NAME_INITTYPE_GC, ""
    ' Use the Set method to specify the NT format of the object name.
    objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strNTName
    ' Use the Get method to retrieve the RFC 1779 Distinguished Name.
    strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
    
    ' Escape any "/" characters with backslash escape character.
    ' All other characters that need to be escaped will be escaped.
    strUserDN = Replace(strUserDN, "/", "\/")
    
    	strAdsPath = "LDAP://" & strUserDN
    	Set objGroup = GetObject("LDAP://" & strGroup)
    	
    	If (objGroup.IsMember(strAdsPath) = True) Then
      	CheckGroup = True
      Else
    		CheckGroup = False
      	End If 
    
    End Function
    
    

    Wirrel
    Tuesday, October 26, 2010 5:40 PM
  • If that is the case, you could move the Excel file creation to the main script. You would use FSO to check if the file for the path you constructed exists. If it exists, you would just open it, and if it doesn''t exist you would create it, naming the worksheets appropriately. Once you get the reference to the workbook you want to write data to, you would just pass a reference to one of the worksheets to the OutputExcel sub. Here is an example:

     

    Const xlExcel7 = 39
    
    Set objFso = CreateObject("Scripting.FileSystemObject") 
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = true
    
    strPathExcel = "C:\Scripts\"
    strFile = "DesktopLocation"
    strYear = Right(Year(Date),2)
    strDay = Day(Date)
    strMonth = Month(Date)
    
    strSaveFile = strPathExcel & strFile & "-" & strYear & _
      "-" & strMonth & "-" & strDay & ".xls"
    
    If objFso.FileExists(strSaveFile) Then
      Set objWorkbook = objExcel.Workbooks.Open(strSaveFile)
    Else
      Set objWorkbook = objExcel.Workbooks.Add
      objWorkbook.Sheets(1).Name = "Default"
      objWorkbook.Sheets(2).Name = "Locked Down"
      objWorkbook.Sheets(3).Name = "Other"
      objWorkbook.SaveAs strSaveFile, xlExcel7
    End If
    
    arrSample = Array("a, b, c, d")
    
    OutputExcel "Default", arrSample, objWorkbook.Sheets("Default")
    OutputExcel "Locked Down", arrSample, objWorkbook.Sheets("Locked Down")
    OutputExcel "Other", arrSample, objWorkbook.Sheets("Other")
    
    objWorkbook.Save
    objWorkbook.Close
    objExcel.Quit
    
    
    
    Sub OutputExcel(ByVal location, ByVal strArray, ByRef objSheet)
      
      ' Add data to the sheet
      objSheet.Cells(1, 1) = location & now
      ' Save the workbook
      objSheet.Parent.Save
      
    End Sub
    
    
    
    
    

    Uros Calakovic
    Tuesday, October 26, 2010 6:27 PM
    Moderator
  • Ok that that solved that part and now leads to another problem.  The two dimensional array needs to be resized but from what I can see apparently you cannot resize the first element of  a two dimensional array.  So now  I need to figure out a way to get the data into an array yet keep the records together.  Is it possible to put an array inside and array.   For instance i have arrTxtArray and I was putting the values of that into another array based on the desktop location.  SO apparently i need to change my approach on how I am reading the data.  Just stuck on how to do it. 
    Wirrel
    Thursday, October 28, 2010 4:42 PM
  • Please start a new thread and provide as much data as possible, possibly with example input and relevant code you've got so far.
    Uros Calakovic
    Thursday, October 28, 2010 4:52 PM
    Moderator
  • Ok just figured it would be easy since all that code is in this thread.  But I will open a new thread.

     


    Wirrel
    Thursday, October 28, 2010 6:07 PM