Solved: Import range of cells in excel to word

[brent.fraser]

I am trying to import a range of cells from Excel to a Word content control. Currently I can import a single cell using the following:
[vba]dataInExcel = workBook.Worksheets("Sheet1").Range("A1").Formula[/vba]

As soon as I change "A1" to "A1:A6", it stops working. Is there another convention that I should be using?

The entire code I have is posted below:
[vba]Public strExcelFile As String
Public Function GetFilePath() As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the file"
fd.Filters.Add "Excel Files", "*.xls; *.xlsx", 1
'fd.Filters.Add "All Files", "*.*"
If fd.Show Then
strExcelFile = fd.SelectedItems(1)
End If
End Function
Public Sub importExcelData()
Dim workBook As workBook
Dim dataInExcel As String
Application.ScreenUpdating = False
GetFilePath
MsgBox strExcelFile
Set workBook = Workbooks.Open(strExcelFile, True, True)
dataInExcel = workBook.Worksheets("Sheet1").Range("A1").Formula
Dim oCC As ContentControl
Set oCC = ActiveDocument.SelectContentControlsByTitle("box1").Item(1)
oCC.Range.Text = dataInExcel
workBook.Close False
Set workBook = Nothing
Application.ScreenUpdating = True
End Sub[/vba]

Is what I am trying to do even possible?

Thanks all in advance.

B.

[brent.fraser]

I would be happy to reference a named range of cells in excel too. That seems to make more sense than just rows/columns.....

thanks again.

B.

[brent.fraser]

After doing some reading, I am thinking I have to place the range in an array and then reference that array into the content control I have created. This way all six rows of information in the named range in the excel spreadsheet will be imported into the content control in Word.

Is this the right path to be going down?

[brent.fraser]

So this is the direction I am heading down. Everything in the below code that is red is what I have added but doesn't work. Everything else works as it should.

[vba]Public strExcelFile As String, workbook As String
Public Sub GetFilePath()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the file"
fd.Filters.Add "Excel Files", "*.xls; *.xlsx", 1
If fd.Show Then
strExcelFile = fd.SelectedItems(1)
End If
End Sub
Public Sub importExcelData()
Dim workbook As workbook
Dim dataInExcel As String
Application.ScreenUpdating = False
GetFilePath
MsgBox strExcelFile
Set workbook = Workbooks.Open(strExcelFile, True, True)
dataInExcel = workbook.Worksheets("Sheet1").Range("A1").Formula
Dim Arr() As Variant
Arr = workbook.Worksheets("Sheet1").Range("A1:A6").Value
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
Debug.Print Arr(R, C)
Next C
Next R
Dim oCC_testing As ContentControl
Set oCC_testing = ActiveDocument.SelectContentControlsByTitle("testing").item(1)
oCC_testing.Range.Text = Arr
Dim oCC_box1 As ContentControl
Set oCC_box1 = ActiveDocument.SelectContentControlsByTitle("box1").item(1)
oCC_box1.Range.Text = dataInExcel
workbook.Close False
Set workbook = Nothing
Application.ScreenUpdating = True
End Sub[/vba]

So basically I am putting the 6 cells in Excel into an array and then trying to import them into a content control called "testing."......

Thanks for any additional eyes on this.

[JamesAl]

What is happening when you run it? Any message?

[brent.fraser]

Hi there James,

I have fixed most of the problem with the below code:

[VBA]Dim workbook As workbook
Dim dataInExcel As String
Application.ScreenUpdating = False
GetFilePath
MsgBox strExcelFile
Set workbook = Workbooks.Open(strExcelFile, True, True)
Dim r As Excel.Range
For Each r In workbook.Worksheets("Project Controls").Range("manpower")
If r.Value <> "" Then
projectControlsManpower = projectControlsManpower & r.Value & vbLf
Else
projectControlsManpower = projectControlsManpower & r.Value
End If
Next
Dim oCC_projectControlsManpower As ContentControl
Set oCC_projectControlsManpower = ActiveDocument.SelectContentControlsByTitle("projectControlsManpower").Item (1)
oCC_projectControlsManpower.Range.Text = projectControlsManpower[/VBA]

I have in it to ignore the cells that are blank so I don't get carriage returns in the Word document.

One thing that I would like to do is have the last entry in the array not have a return as stated here:
[VBA]If r.Value <> "" Then
projectControlsManpower = projectControlsManpower & r.Value & vbLf
Else
projectControlsManpower = projectControlsManpower & r.Value
[/VBA]

Is there a way to detect the last entry in the array and not have a return? Not a huge deal, it just means that in the word document I have to delete the last carriage return.

Thanks for asking about it.

Brent

[gmaxey]

string = Left(string, Len(string) - 1)

[brent.fraser]

Thanks for the code Greg,

How would one incorporate that into the existing code?

If the cell is not blank but it is the last in the array, don't have a paragraph return? I think that's the logic that I need to incorporate.

Make sense?

[brent.fraser]

Or I could so something like this:

[VBA]

If r.Value <> "" And "is not the last entry - code" Then
projectControlsManpower = projectControlsManpower & r.Value & vbLf
Else
projectControlsManpower = projectControlsManpower & r.Value

[/VBA]

Will that work? I think it might do just want I need.

B.

[gmaxey]

Brent,

projectControlsManpower is a string. It appears that unless all the cells are empty then it will always have a dangling vbLf

So clip if off:

projectControlsManpower = Left(projectControlsManpower, Len(projectControlsManpower) - 1)

[brent.fraser]

I am going through a loop as follows:
[VBA]For Each r In workbook.Worksheets("Project Controls").Range("manpower")
If r.Value <> "" Then
projectControlsManpower = projectControlsManpower & r.Value & vbLf
Else
projectControlsManpower = projectControlsManpower & r.Value
End If
[/VBA]

So, do I do it like this:
[VBA]For Each r In workbook.Worksheets("Project Controls").Range("manpower")
If r.Value <> "" Then
projectControlsManpower = Left(projectControlsManpower, Len(projectControlsManpower) - 1)
Else
projectControlsManpower = projectControlsManpower & r.Value
End If
[/VBA]

I tried it and I get an error stating "invalid procedure call or argument"

Sorry, still not that well versed in VBA but still working at it.

[gmaxey]

Brett,

There really isn't any reason to physically open the Excel file to do this sort of thing. The following provides an example of how you can get data from a defined range in and Excel file and put it in a CC:

[VBA]Option Explicit
Sub Demo()
Dim varData As Variant
Dim lngA As Long, lngB As Long
Dim strText As String
xlFillArray varData, "C:\Test.xlsx", False, "SELECT * FROM [TestRange];"
For lngA = 0 To UBound(varData, 1)
For lngB = 0 To UBound(varData, 2)
strText = strText & varData(lngA, lngB)
If lngA < UBound(varData, 1) Then strText = strText & vbLf
Next lngB
Next lngA
ActiveDocument.ContentControls(1).Range.Text = strText
lbl_Exit:
Exit Sub
End Sub
Public Function xlFillArray(varData As Variant, strWorkbook As String, _
bSuppressHeader As Boolean, strSQL As String)
Dim oConn As Object
Dim strConnection As String
Dim oRecordSet As Object
Dim lngIndex As Long
'Create connection:
Set oConn = CreateObject("ADODB.Connection")
If bSuppressHeader Then
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Else
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
End If
oConn.Open ConnectionString:=strConnection

Set oRecordSet = CreateObject("ADODB.Recordset")
'Read the data from the worksheet.
oRecordSet.Open strSQL, oConn, 3, 1
With oRecordSet
'Find the last record.
.MoveLast
'Get count.
lngIndex = .RecordCount
'Return to the start.
.MoveFirst
End With
On Error GoTo Cleanup
varData = oRecordSet.GetRows(lngIndex)
Cleanup:
If oRecordSet.State = 1 Then oRecordSet.Close
Set oRecordSet = Nothing
If oConn.State = 1 Then oConn.Close
Set oConn = Nothing
lbl_Exit:
Exit Function
End Function
[/VBA]

[brent.fraser]

Hey Greg,

Thanks for the code. To be honest, it seems overwhelming to have to start from scratch again.... I think it will cause me (and this forum) more grief as I try to figure it out.

What I have now is to browse to the excel file to pick it and it puts the ranges into the content controls. The last piece (which isn't a show stopper) is to have the last entry in the array to not have a paragraph/carriage return.

Here's the code I am using:
[VBA]Public strExcelFile As String, workbook As String
Public Sub GetFilePath()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the file"
fd.Filters.Add "Excel Files", "*.xls; *.xlsx", 1
If fd.Show Then
strExcelFile = fd.SelectedItems(1)
End If
End Sub
Public Sub importExcelData()
Dim workbook As workbook
Dim dataInExcel As String
Application.ScreenUpdating = False
GetFilePath
MsgBox strExcelFile
Set workbook = Workbooks.Open(strExcelFile, True, True)
Dim r As Excel.Range
'############ Project Controls Manpower Information ####################
For Each r In workbook.Worksheets("Project Controls").Range("manpower")
If r.Value <> "" Then
'projectControlsManpower = projectControlsManpower & r.Value & vbLf
projectControlsManpower = Left(projectControlsManpower, Len(projectControlsManpower) - 1)
Else
projectControlsManpower = projectControlsManpower & r.Value
End If
Next
Dim oCC_projectControlsManpower As ContentControl
Set oCC_projectControlsManpower = ActiveDocument.SelectContentControlsByTitle("projectControlsManpower").Item (1)
oCC_projectControlsManpower.Range.Text = projectControlsManpower
'############ Project Controls Current Week Information ####################
For Each r In workbook.Worksheets("Project Controls").Range("currentWeek")
If r.Value <> "" Then
projectControlsCurrentWeek = projectControlsCurrentWeek & r.Value & vbLf
Else
projectControlsCurrentWeek = projectControlsCurrentWeek & r.Value
End If
Next
Dim oCC_projectControlsCurrentWeek As ContentControl
Set oCC_projectControlsCurrentWeek = ActiveDocument.SelectContentControlsByTitle("projectControlsCurrentWeek").I tem(1)
oCC_projectControlsCurrentWeek.Range.Text = projectControlsCurrentWeek[/VBA] and so on..........

I will play around with yours and see what comes of it.

As always, thanks for the help.

Hope you are well in N.C.

[gmaxey]

[VBA]Public Sub importExcelData()
Dim workbook As workbook
Dim r As Excel.Range
Application.ScreenUpdating = False
GetFilePath
Set workbook = Workbooks.Open(strExcelFile, True, True)
For Each r In workbook.Worksheets(1).Range("TestRange")
If r.Value <> "" Then
projectControlsManpower = projectControlsManpower & r.Value & vbLf
End If
Next
ActiveDocument.ContentControls(1).Range.Text = Left(projectControlsManpower, Len(projectControlsManpower) - 1)
End Sub[/VBA]

[brent.fraser]

Hey, that's great and works really well.

Is it working and has a lot less code.

Is there a way I can name the content control rather than numbering them? Tehy are named in the Word document.

[vba]Dim oCC_projectControlsManpower As ContentControl
Set oCC_projectControlsManpower = ActiveDocument.SelectContentControlsByTitle("projectControlsManpower").Rang e.Text = Left(projectControlsManpower, Len(projectControlsManpower) - 1)
oCC_projectControlsManpower.Range.Text = projectControlsManpower[/vba]

Sorry for being a pain in the butt! I do appreciate your help and guidance.

[gmaxey]

Brent,

You can set the CC of interest as you had been doing. For testing and to save time I only put one CC in my test document and so I used a numbered index (1) in my code.

[brent.fraser]

Bingo...... awesome work Mr. Maxey!!!!!!!! As always, you have made this work very well.

You are awesome!!!

Thanks again