Writing data from excel into an existing word table

[KatieF]

I can currently get my script to write all highlighted data into a file of my choosing. What I need to do is write it to the word documents existing table. It writes straight over it at the minute and I'm not 100% on how you reference the table you wish to use. My code is below

Private Sub CommandButton1_Click()

Dim textFile As String, rng As Range, cellValue As Variant, i As Integer, x As Integer


'File to write to that contains table
textFile = Application.DefaultFilePath & "\testFile.doc"


Set rng = Selection


Open textFile For Output As #1


For i = 1 To rng.Rows.Count
   For x = 1 To rng.Columns.Count


cellValue = rng.Cells(i, x).Value




If x = rng.Columns.Count Then
Write #1, cellValue
Else
Write #1, cellValue,
End If


Next x
Next i


'Print the contents of cellValue to the immediate window
Debug.Print cellValue


'Ensure file being wrote to is closed
Close #1


'Print a message box to show that it has finished writing the data to the document
MsgBox ("Done")


End Sub

If anyone can give a little push in the right direction I'd appreciate it!

 

[Macropod]

It's a bit more complicated than that...

You need to automate Word and use Word's own tools to populate the table.

The following code starts Word if it isn't already running, opens the document if it's closed, populates the document, saves the document then closes it if previously closed and quits Word if previously not running.

As coded, the macro opens a document named 'Target Document.doc' in the user's 'Documents' folder and populates the first table in that document. No error checking has been used to guard against a missing table, columns or rows.

Private Sub CommandButton1_Click()
Dim wdApp As Object, wdDoc As Object, StrDocNm As String
Dim xlRng As Excel.Range, i As Long, x As Long
Dim bStrt As Boolean, bFound As Boolean
'Check whether the document exists
StrDocNm = "C:\Users\" & Environ("Username") & "\Documents\Target Document.doc"
If Dir(StrDocNm) = "" Then
  MsgBox "Cannot find the designated document: " & StrDocNm, vbExclamation
  Exit Sub
End If
' Test whether Word is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Word if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Word, so we can terminate it later.
  bStrt = True
End If
On Error GoTo 0
'Get our Excel range
Set xlRng = Selection
'Check if the Word document is open.
bFound = False
With wdApp
  'Hide our Word session
  If bStrt = True Then .Visible = False
  For Each wdDoc In .Documents
    If wdDoc.FullName = StrDocNm Then ' We already have it open
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrDocNm) = True Then
      ' Report and exit if true
      MsgBox "The Word document is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set wdDoc = .Documents.Open(FileName:=StrDocNm)
    If wdDoc Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrDocNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  With wdDoc
    'Only now can we can process the document!!!
    With .Tables(1)
      For i = 1 To xlRng.Rows.Count
          For x = 1 To xlRng.Columns.Count
            .Cell(i, x).Range.Text = xlRng.Cells(i, x).Value
          Next
      Next
    End With
    .Save
    'Close the document if we opened it
    If bFound = False Then .Close
  End With
  If bStrt = True Then .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlRng = Nothing
End Sub

Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

 

[KatieF]

Hi there,

Thank you for posting that and taking the time to do so! After it iterates through this a few times, I get the error 5941 the requested member of the collection does not exist . Do you know why this happens?

.Cell(i, x).Range.Text = xlRng.Cells(i, x).Value
          Next

 

[Macropod]

After it iterates through this a few times, I get the error 5941 the requested member of the collection does not exist . Do you know why this happens?

It happens because the cell you're trying to populate doesn't exist. As I said:

No error checking has been used to guard against a missing table, columns or rows.

 

[KatieF]

Hi there, I understand what you mean - I should of realised! There is one thing that does slightly confuse me however, when it retrieves my data in the table, it is leaving cells empty when in the excel file there is only a block of 3 columns that are empty. I've uploaded a photo to show what I mean. (it occurs after the name, the other gaps should be there). In the excel sheet there is numbers that have been removed and the gaps match the amount of letter removed i.e e + f are missing after column d with the name in.

 

[KatieF]

I've just realised who ever created this has hid random columns for some reason - so it's not an issue! Cheers for the help much appreciated! ^.^