View Single Post
  #1   Report Post  
puppetsock puppetsock is offline
Junior Member
 
Posts: 1
Default ExportToExcel Macro

Hi, I have a macro I use in AttachmateWRQ, Reflections. The macro is supposed to take the text I highlighted and ask me what delimiter I want to use, then export it into Excel. It's not working...I'm getting an error (attached). This VB code works in Visual Studio but not in Reflections. Any thoughts? I am using Excel 2007 and AttachmateWRQ Version 14.0.

Thanks in advance!!


' DESCRIPTION: Prompts for a delimiter, launches Excel, and uses the delimiter to parse highlighted sText into individual columns


Sub ExportToExcel()
On Error GoTo ErrorHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sDelimiter As String
Dim sText As String
Dim Selection As VbMsgBoxResult

sDelimiter = InputBox("Enter the delimiter you'd like to use.", "Enter Delimiter", "^")

If Len(sDelimiter) 0 Then
Copy (rcSelection)
sText = GetClipboardText()
Else
Exit Sub
End If

If Not Len(sText) 0 Then
MsgBox ("Please select text you'd like to export to Excel before using this macro.")
Exit Sub
End If

Selection = MsgBox("Format for column headers?", vbYesNo, "Special Formatting")

'Open and activate Excel workbook
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Add
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)

wks.Activate
appExcel.Application.Visible = True
wks.Paste

Set objRange = wks.Range("A1").EntireColumn
objRange.TextToColumns Destination:=wks.Range("A1"), DataType:=xlDelimited, Other:=True, OtherChar:=sDelimiter

If Selection = vbYes Then '*MB 04/12 - Additionally format if Yes
With appExcel
'Freeze top row
.ActiveWindow.SplitColumn = 0
.ActiveWindow.SplitRow = 1
.ActiveWindow.FreezePanes = True

'Bold column headers
.Rows(1).Font.Bold = True

'Select all cells
.Cells.HorizontalAlignment = xlLeft
.Cells.VerticalAlignment = xlBottom
.Cells.WrapText = False
.Cells.Orientation = 0
.Cells.AddIndent = False
.Cells.IndentLevel = 0
.Cells.ShrinkToFit = False
.Cells.ReadingOrder = xlContext
.Cells.MergeCells = False
.Cells.AutoFilter
.Cells.EntireColumn.AutoFit

'Finish by selecting top-left cell
.Cells(1, 1).Select
End With
End If

ErrorHandler:
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set objRange = Nothing
End Sub
Attached Images