Populate Excel database from a word form 1

[DrSmyth]

Hi,

I need to populate an excel spreadsheet with data that has been entered into a word form.

Basically somebody has a word form that they have just filled out, they click on a button which e-mails the form to somebody (Have already taken care of this bit) and then the information in the word form is added to an excel spreadsheet.

I'm having trouble finding the next blank cell in the excel document from word, does anybody have any suggestions.

 

[Yesuslave]

Try this, and let me know if you need something adjusted...


Sub Try()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet


Set xlApp = CreateObject("Excel.Application&quot
xlApp.Visible = True

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'or
'Set xlWB = xlApp.Workbooks.Open("C:\Foldername\Filename.xls&quot
Set xlWS = xlWB.Worksheets(1)
With xlWS
.Cells(2, 1).Select
Do Until xlApp.ActiveCell.Text = ""
ActiveCell.Offset(1, 0).Select
Loop

End With

End Sub

 

[Yesuslave]

Or This:

Sub Try()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet


Set xlApp = CreateObject("Excel.Application&quot
xlApp.Visible = True

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'or
'Set xlWB = xlApp.Workbooks.Open("C:\Foldername\Filename.xls&quot
Set xlWS = xlWB.Worksheets(1)
With xlWS
.Cells(2, 1).Select
Do Until xlApp.ActiveCell.Text = ""
xlApp.ActiveCell.Offset(1, 0).Select
Loop

xlApp.ActiveCell.Formula = "Hi there"


End With

End Sub

 

[SkipVought]

hi,

This is very time consuming and inefficient

With xlWS
    .Cells(2, 1).Select
Do Until xlApp.ActiveCell.Text = ""

Use this instead

With xlWS
  LastRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row 
End with

Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[DrSmyth]

Cheers lads, I'll try and combine the coding you've suggested with what i've got already and see if it works....

I'll get back and let you know if i have any more problems

 

[DrSmyth]

Yesuslave,

I've taken your code and combined it with the stuff i've already made and have come up with this:

Private Sub Document_Close()
Dim StrngTxt As String
Dim StrngTxt1 As String
Dim response As Boolean
Dim response1 As Boolean
Dim varData(112) As Variant
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet

varData(0) = ActiveDocument.FormFields("Text10&quot.Result
varData(1) = ActiveDocument.FormFields("Text7&quot.Result
varData(2) = ActiveDocument.FormFields("Text22&quot.Result
varData(3) = ActiveDocument.FormFields("Text12&quot.Result
varData(4) = ActiveDocument.FormFields("Text24&quot.Result
varData(5) = ActiveDocument.FormFields("Text7&quot.Result
varData(6) = ActiveDocument.FormFields("Text6&quot.Result
varData(7) = ActiveDocument.FormFields("Text8&quot.Result
varData(8) = ActiveDocument.FormFields("Text7&quot.Result
varData(9) = ActiveDocument.FormFields("Text10&quot.Result
varData(10) = ActiveDocument.FormFields("Text7&quot.Result
varData(11) = ActiveDocument.FormFields("Text7&quot.Result
varData(12) = ActiveDocument.FormFields("Text7&quot.Result


Set xlApp = CreateObject("Excel.application&quot
xlApp.Visible = True
Set xlWB = xlApp.workbooks.Open("C:\Referral Tracking 2003.xls&quot
Set xlWS = xlWB.worksheets(1)
With xlWS
.Cells(2, 1).Select
Do Until xlApp.ActiveCell.Text = ""
ActiveCell.Offset(1, 0).Select
Loop
End With
xlApp.ActiveCell.FormulaR1C1 = varData(0)
xlApp.ActiveCell.Offset(0, 1).FormulaR1C1 = varData(1)
xlApp.ActiveCell.Offset(0, 2).FormulaR1C1 = varData(2)
xlApp.ActiveCell.Offset(0, 3).FormulaR1C1 = varData(3)
xlApp.ActiveCell.Offset(0, 4).FormulaR1C1 = varData(4)
xlApp.ActiveCell.Offset(0, 5).FormulaR1C1 = varData(5)
xlApp.ActiveCell.Offset(0, 6).FormulaR1C1 = varData(6)
xlApp.ActiveCell.Offset(0, 7).FormulaR1C1 = varData(7)
xlApp.ActiveCell.Offset(0, 8).FormulaR1C1 = varData(8)
xlApp.ActiveCell.Offset(0, 9).FormulaR1C1 = varData(9)
xlApp.ActiveCell.Offset(0, 10).FormulaR1C1 = varData(10)
xlApp.ActiveCell.Offset(0, 11).FormulaR1C1 = varData(11)

StrngTxt = ActiveDocument.FormFields("Text12&quot.Result
response1 = MsgBox("Would you like to save this record", vbYesNo, "Save Record&quot
ActiveDocument.SaveAs ("C:\referral" & StrngTxt & ".doc&quot
stringTxt1 = InputBox("If you would like to send this form please Enter E-mail here and click OK, otherwise click on cancel", "E - Mail&quot
response = MsgBox("Would You Like to Print This Document", vbYesNo, "Print&quot

End Sub

However, it seems a bit bulky for what it's doing, is there a way of scrolling through the array and simply inserting the value into the next offcet(0,1) cell??

 

[SkipVought]

Dr,

consider a loop instead of this

xlApp.ActiveCell.FormulaR1C1 = varData(0)
xlApp.ActiveCell.Offset(0, 1).FormulaR1C1 = varData(1)
xlApp.ActiveCell.Offset(0, 2).FormulaR1C1 = varData(2)
xlApp.ActiveCell.Offset(0, 3).FormulaR1C1 = varData(3)
xlApp.ActiveCell.Offset(0, 4).FormulaR1C1 = varData(4)
xlApp.ActiveCell.Offset(0, 5).FormulaR1C1 = varData(5)
xlApp.ActiveCell.Offset(0, 6).FormulaR1C1 = varData(6)
xlApp.ActiveCell.Offset(0, 7).FormulaR1C1 = varData(7)
xlApp.ActiveCell.Offset(0, 8).FormulaR1C1 = varData(8)
xlApp.ActiveCell.Offset(0, 9).FormulaR1C1 = varData(9)
xlApp.ActiveCell.Offset(0, 10).FormulaR1C1 = varData(10)
xlApp.ActiveCell.Offset(0, 11).FormulaR1C1 = varData(11)

With xlApp.Activecell
  For i = 0 to 11
    .Offset(0, i).Value = varData(i)
  Next
End With

Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[DrSmyth]

Cheers Skip.... Works like a dream!!!

 

[DrSmyth]

OK, i've come across a couple of other problems with this programme and don't know whether to stick them in this thread or start a new one... I'll try this thread for now.

The code i've currently got is as follows

Private Sub Document_Close()
Dim StrngTxt As String
Dim StrngTxt1 As String
Dim varData(10) As Variant
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
If ActiveDocument.Name <> &quot;PSM Referral Form.doc&quot; Then Call finish

varData(0) = ActiveDocument.FormFields(&quot;Dropdown1&quot.Result
varData(1) = ActiveDocument.FormFields(&quot;Text6&quot.Result
varData(2) = ActiveDocument.FormFields(&quot;Text19&quot.Result
varData(3) = ActiveDocument.FormFields(&quot;Text9&quot.Result
varData(4) = &quot;N/A&quot;
varData(5) = &quot;N/A&quot;
varData(6) = ActiveDocument.FormFields(&quot;Dropdown2&quot.Result
varData(7) = ActiveDocument.FormFields(&quot;Text4&quot.Result
varData(8) = ActiveDocument.FormFields(&quot;Text27&quot.Result
varData(9) = ActiveDocument.FormFields(&quot;Text2&quot.Result
varData(10) = ActiveDocument.FormFields(&quot;Text22&quot.Result



Set xlApp = CreateObject(&quot;Excel.application&quot
xlApp.Visible = True
Set xlWB = xlApp.workbooks.Open(&quot;C:\Referral Tracking 2003.xls&quot
Set xlWS = xlWB.worksheets(1)
With xlWS
.Cells(2, 2).Select
Do Until xlApp.ActiveCell.Text = &quot;&quot;
ActiveCell.Offset(1, 0).Select
Loop
End With
With xlApp.ActiveCell
For i = 0 To 10
.Offset(0, i).Value = varData(i)
Next
End With
On Error Resume Next
xlWB.Save
xlApp.Quit
Set xlApp = Nothing


StrngTxt = ActiveDocument.FormFields(&quot;Text12&quot.Result
response1 = MsgBox(&quot;Would you like to save this record&quot;, vbYesNo, &quot;Save Record&quot
If response1 = vbYes Then ActiveDocument.SaveAs (&quot;C:\referral&quot; & StrngTxt & &quot;.doc&quot
response = MsgBox(&quot;Would You Like to Print This Document&quot;, vbYesNo, &quot;Print&quot
If response = vbYes Then ActiveDocument.PrintOut
stringTxt1 = InputBox(&quot;If you would like to send this form please Enter E-mail here and click OK, otherwise click on cancel&quot;, &quot;E - Mail&quot
response2 = MsgBox(&quot;Would you like to add another referral?&quot;, vbYesNo)
If response2 = vbYes Then Documents(&quot;C:\PSM Referral Form.doc&quot.Open
If response2 = vbNo Then ActiveDocument.Close

End Sub

Sub finish()
Application.Quit
End Sub

But i-m getting a few problems

Firstly, when somebody opens up a saved version of this document when they close it the code starts up again, i thought i could get clever with the line:

If ActiveDocument.Name <> &quot;PSM Referral Form.doc&quot; Then Call finish

this runs the finish sub routine, but this gives me an error message.

Secondly when i run the line of code that closes the document, it gives me an error message saying that quitting the document will cause print job to cease...

Finally, i'm getting an error message saying that part of the page is out oof the print area, if i click ok then the document prints fine, is there a way of subduing error messages like these?

Any help will be gratefully received, or if you think i should start a new thread then i will do that...

DR

 

[SkipVought]

DR

Why don't you post this as a new thread. You'll get some fresh help.

Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884