rbwallis
02-24-2017, 09:42 PM
Hello, here I am on my continued journey to paste copied data from Word to Excel. In my latest version of the code, The data is copied, but Excel opens two files (Book1 and Book2) and pastes the info in both windows. I have pored over the code, but I can't figure out what is causing the second file to open. Any help would be greatly appreciated. Thanks, Rob
Here is my current code:
Sub ExportwordtoexcelNew()
Dim wordDoc As Object
Dim oXL As Excel.Application
Dim DocTarget As Word.Document
Dim Target As Excel.Workbook
Dim tSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you want Excel to open and paste your selection?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "QuikBots for Word")
If YesOrNoAnswerToMessageBox = vbYes Then
Set wordDoc = GetObject(, "word.application")
wordDoc.Selection.WholeStory
Selection.Copy
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
'Install Add-ins
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
For Each oAddIn In oXL.AddIns
With oAddIn
If .Installed Then
.Installed = False
.Installed = True
End If
End With
Next oAddIn
End If
oXL.Visible = True
Set Target = oXL.Workbooks.Add
Set tSheet = Target.Sheets(1)
tSheet.Paste
Else
End If
Set oXL = Nothing
End Sub
Here is my current code:
Sub ExportwordtoexcelNew()
Dim wordDoc As Object
Dim oXL As Excel.Application
Dim DocTarget As Word.Document
Dim Target As Excel.Workbook
Dim tSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you want Excel to open and paste your selection?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "QuikBots for Word")
If YesOrNoAnswerToMessageBox = vbYes Then
Set wordDoc = GetObject(, "word.application")
wordDoc.Selection.WholeStory
Selection.Copy
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
'Install Add-ins
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
For Each oAddIn In oXL.AddIns
With oAddIn
If .Installed Then
.Installed = False
.Installed = True
End If
End With
Next oAddIn
End If
oXL.Visible = True
Set Target = oXL.Workbooks.Add
Set tSheet = Target.Sheets(1)
tSheet.Paste
Else
End If
Set oXL = Nothing
End Sub