Adding entries to an existing spreadsheet 1

[teckiejon]

Can anybody out there help me with a script to add entries to an excel document. I have seen scripts that write to individual cells thats values are specified in the script such as:

Dim xl
set xl = wscript.createobject("excel.application")
xl.visible = true
xl.workbooks.add()
xl.Cells(1,1).Value = Value1
xl.Cells(1,2).Value = Value2
xl.Cells(1,3).Value = Value3

but I am looking to write a script that adds entires to 1 row of 4 columns in an exisitng table everytime it is run. I have been using the following code in MS Word in the meantime which just uses the pre defined variables to add a line to the existing document:

Dim wrd
set wrd = wscript.createobject("word.application")
'wrd.visible = true
wrd.documents.open "c:\newusers\Newusers.doc"
wrd.Selection.TypeText vbcrlf & strUser & " - " & strUsrNm & " & " Created: " & Date & " " & Time
wrd.activedocument.Close
wrd.application.quit

But the entires would be much better referenced in a spreadsheet. I have a feeling that the excel solution won't be as simple as the word version is at the moment! Any help would be appreciated

 

[teckiejon]

I have found an older post by Mark D Mac (thanks Mark) that seems to fit the bill if I adjust it a bit but I seem to get an error. The script reads as follows:

Dim appexcel
set appexcel = wscript.createobject("excel.application")
'appexcel.visible = true
appexcel.workbooks.open "c:\newuser.xls"

r = 1

do until len(appexcel.cells(r, 1).value) = 0
r = r + 1
Loop
appexcel.cells(r, 1).value = strUser

p = 1

do until len(appexcel.cells(p, 2).value) = 0
p = p + 1
Loop
appexcel.cells(p, 2).value = strUsrNm

q = 1

do until len(appexcel.cells(q, 3).value) = 0
q = q + 1
Loop
appexcel.cells(q, 3).value = strgrps

s = 1

do until len(appexcel.cells(s, 4).value) = 0
s = s + 1
Loop
appexcel.cells(s, 4).value = strvgd

t = 1

do until len(appexcel.cells(t, 5).value) = 0
t = t + 1
Loop
appexcel.cells(t, 5).value = strnm2


appexcel.save
appexcel.application.quit


Which all seems to work fine and populates the next 5 free cells in the row below the last line of text. However when the spreadsheet tries to save I get the following error:

A file named RESUME.XLW already exists in this location

Is it something to do with the way that I am saving the workbook at the end of the script? Again any help gratefully appreciated....

 

[PHV]

Try something like this:
Dim appexcel, wb
Set appexcel = WScript.CreateObject("Excel.Application")
'appexcel.Visible = True
Set wb=appexcel.Workbooks.Open "c:\newuser.xls"
r = 1
Do Until Len(wb.Cells(r, 1).Value) = 0
r = r + 1
Loop
wb.Cells(r, 1).Value = strUser
wb.Cells(r, 2).Value = strUsrNm
wb.Cells(r, 3).Value = strgrps
wb.Cells(r, 4).Value = strvgd
wb.Cells(r, 5).Value = strnm2
wb.Save
Set wb = Nothing
appexcel.Quit
Set appexcel = Nothing

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[TimRHSD]

You can also add a function to do it.

Function AddRow(RowArray)  'idxRow s/b set to 1 at start 
                           ' of your program
    idxCol = 1
    For Each idxCell in RowArray
       xl.ActiveSheet.Cells(idxRow,idxCol).Activate
       xl.ActiveCell = idxCell
       idxCol = idxCol + 1
    Next
    idxRow = idxRow + 1 'Bump the row down one.
End Funtion

Then in your program add something like this;

DataFields = Array(strUser,strUserNm,strUsrGrps,strvgd,strnm2)
AddRow(DataFields)

I have used this logic for years and it is really easy to cut and paste.

HTH,

Tim

Tim Rutherford

http://www.Manna-Consulting.com

 

[teckiejon]

Thanks to both of you will investigate both possibilities on Monday when I'm back in the office and let you know how things go

 

[dilettante]

There always seems to be more than one way to "skin a cat" as they say.

You can also do this sort of thing easily using ADO and Jet instead of Excel. The advantage is that this works for unattended scripts that aren't run manually (or that might run without a user logged on). It also doesn't require Excel to be installed on the machine where it runs, as long as you have Jet 4.0 installed along with the usual set of Installable ISAM (IISAM) modules.

These ought to be present on nearly any Win2K or later machine, and are easily installed on older machines if necessary without requiring any Office product license.


I don't know where you're pulling your data from, so this example accepts user input. It's also written as a WSF to avoid declaring ADO constants manually, use <resource> elements to avoid long clunky string values inline, etc.

Note that when the first row doesn't contain header labels, ADO field names for Excel columns look like F1, F2, etc. I've also used Subs here to try to make things clearer, but you can code all of this inline.

<job>
  <!-- AddRow.wsf

       This example requires that the workbook
       exists, Sheet1 exists in it, and at least
       the first row has the 1st 5 columns filled
       in already.
  -->
  <reference object="ADODB.Recordset"/>
  <object id="rsXL" progid="ADODB.Recordset"/>
  <resource id="strConnection">
    Provider=Microsoft.Jet.OLEDB.4.0;
    Data Source="newuser.xls";
    Extended Properties="Excel 8.0;HDR=No"
  </resource>
  <script language="VBScript">
    Dim strInput
    Dim strUser, strUsrNm, strgrps, strvgd, strnm2

    Sub GetInput()
      strInput = InputBox("Enter User, UserNm, grps, vgd, nm2")
      strInput = Split(strInput, ",")
      strUser   = Trim(strInput(0))
      strUsrNm  = Trim(strInput(1))
      strgrps   = Trim(strInput(2))
      strvgd    = Trim(strInput(3))
      strnm2    = Trim(strInput(4))
    End Sub

    Sub OpenXL()
      rsXL.Open "[Sheet1$]", _
                getResource("strConnection"), _
                adOpenDynamic, _
                adLockOptimistic, _
                adCmdTable
    End Sub

    Sub AddRow(str1, str2, str3, str4, str5)
      rsXL.AddNew Array("F1", "F2", "F3", "F4", "F5"), _
                  Array(str1, str2, str3, str4, str5)
      rsXL.Update
    End Sub

    Sub CloseXL()
      rsXL.Close
    End Sub

    GetInput
    OpenXL
    AddRow strUser, strUsrNm, strgrps, strvgd, strnm2
    CloseXL
  </script>
</job>

Automating Excel gives you more control over setting fonts, column widths, etc. but if you just want to append new data to a worksheet ADO will do the job.

 

[teckiejon]

PHV tried you solution first as it was the quickect to copy and paste into my exisitng script. I got an 'expected end of staement' error which seemd to be resolved by changing:

Set wb=appexcel.Workbooks.Open "c:\newusers\newuser.xls"
to

Set wb=appexcel.Workbooks.Open ("c:\newusers\newuser.xls")

Now I get a message that the object 'cells' isn't supported on the following line:

Do Until Len(wb.Cells(r, 1).Value) = 0

I will have a play round but any suggestions that save me time would be greatly appreciated

 

[PHV]

Try this:
Try something like this:
Dim appexcel, wb
Set appexcel = WScript.CreateObject("Excel.Application")
With appexcel
'.Visible = True
Set wb=.Workbooks.Open("c:\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser
.Cells(r, 2).Value = strUsrNm
.Cells(r, 3).Value = strgrps
.Cells(r, 4).Value = strvgd
.Cells(r, 5).Value = strnm2
wb.Save
Set wb = Nothing
.Quit
End With
Set appexcel = Nothing

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[teckiejon]

PHV
Thanks a lot for that the script works brilliantly now.

 

[teckiejon]

I'm afraid I have a new problem with this script. There are two groups of people using my excel spreadsheet both accessing the information in it for different purposes. One group may make an entry before the other group so I now need to modify the script that I already have to check to see whether an entry exists. I had proposed to use the following code:

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile("c:\newusers\newuser.xls")
While oFile.AtEndOfStream <> True
strLine = oFile.ReadLine
If InStr(strLine, "Test User") > 0 Then

WScript.Echo "Test User Exists"
'code will go here

Else

Wscript.echo "Test USer Does not exist"
'code will go here
End If
Wend

The problem that I have is that:
Group1: Access the spreadsheet to populate the first 9 columns from within the script
(which currently works fine)
Group2: Now need to access the spreadsheet to create an entry in columns 1 and 9 only with the same data as would be created by the script
If column 1 and 9 have existing entries then the script only needs to populate columns 2 to 8 yet if there are no exisiting entries then all 9 fields need to be populated.

The script that I am currently using from this post is as follows:

im appexcel2, wb2
Set appexcel2 = WScript.CreateObject("Excel.Application")
With appexcel2
'.Visible = True
Set wb2=.Workbooks.Open("\\ls-fileshare-02\d$\Data\ISG\SiteSupport\newusers\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser2
.Cells(r, 2).Value = strUsrnm2
.Cells(r, 3).Value = strgrps2
.Cells(r, 4).Value = strvgd2
.Cells(r, 5).Value = strnm3
.Cells(r, 6).Value = date
.Cells(r, 7).Value = time
.Cells(r, 8).Value = wshnetwork.username
.Cells(r, 9).Value = strconf
wb2.Save
Set wb2 = Nothing
.Quit
End With
Set appexcel2 = Nothing

But this only populates the next 9 fields if all of the rows above are fully populated. I have the feeling that I will have to re write the whole lot but would really appreciate a nudge in the right direction as I have searched the forum for 'append' and 'excel' topics

 

[tsuji]

Hello techiejon,

Group1: Access the spreadsheet to populate the first 9 columns from within the script(which currently works fine)
Group2: Now need to access the spreadsheet to create an entry in columns 1 and 9 only with the same data as would be created by the script
If column 1 and 9 have existing entries then the script only needs to populate columns 2 to 8 yet if there are no exisiting entries then all 9 fields need to be populated.

Can't really figure out what you want to say for Group2. Maybe it's just me.

regards - tsuji

 

[teckiejon]

Sorry let me explain from my rather garbled post above:

Group1 are network admins who create user accounts and then log the information to an excel spreadsheet (using the script)

Group 2 are HR staff who due to poor in house timing sometimes receive the job to process a new user before the accounts have been created by group1. They only need to fill in the first and ninth field of the spreadsheet as these are the users name and confirmation that a contract has been signed

Therefore there may be an instance where there is a need for the script to only populate fields 2 - 8 if a partial entry already exists.

So what I really need is to be pointed in the direction of excel functions that will allow blank spaces in a spreadsheet and then let me append exisitng entries which I assume will be SQL driven. I am currenlty investigating the possibility of using an access database instead but would rather stick with excel if possible.

Rgds

Jon

 

[tsuji]

techiejon,

If I can take Cells(r,1) and Cells(r,2) as sufficient indicator of the two possible situations in the event set, you can do this. (Side-notes: I do not fully understand how your script as shown should work---I don't think, so I add here and there something that I can be more readily understand and confident in functioning.)

Dim appexcel2, wb2, ws2
Set appexcel2 = WScript.CreateObject("Excel.Application")
appexcel2.Visible = True
Set wb2=.Workbooks.Open("\\ls-fileshare-02\d$\Data\ISG\SiteSupport\newusers\newuser.xls")
Set ws2 = wb2.worksheets(1)   '[blue]<<<checking this[/blue]
With ws2
    bExhausted = false
    r = 1
    Do Until bExhausted
        If Len(.Cells(r, 2).Value) = 0 Then
            If Len(.Cells(r,1).Value) = 0 Then
                bExhausted = True
            Else
                .Cells(r, 2).Value = strUsrnm2
                .Cells(r, 3).Value = strgrps2
                .Cells(r, 4).Value = strvgd2
                .Cells(r, 5).Value = strnm3
                .Cells(r, 6).Value = date
                .Cells(r, 7).Value = time
                .Cells(r, 8).Value = wshnetwork.username
            End If
        End If
        r = r + 1
    Loop
End With
Set ws2 = Nothing
wb2.Save
Set wb2 = Nothing
appexcel2.Quit
Set appexcel2 = Nothing

regards - tsuji