Is it possible to export from microsoft access into microsoft excel, but have the columns on the ledt and the rows going down? I know the default export has it the other way arround.
Data is being being provided to a 3-rd party but they want in in the above format
So like:
Column1 | Row1 | Row2
Column2 | Row1 | Row2
Column3 | Row1 | Row2
Either open the table as a recordset and loop this multiple time filling a temporary table; then export this.
Or export the table as is to Excel, then call Transpose to "rotate" the filled range:
TRANSPOSE function
If you really have to do this in Access rather than looking at using TRANSPOSE in Excel, you will probably want to use some VBA to loop the fields in a recordset. Something like this should give you an idea (you will need to set a reference to the Excel object library in order to use early binding):
Sub sExportExcelTransposed()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim objXL As New Excel.Application
Dim objXLBook As Excel.Workbook
Dim objXLSheet As Excel.Worksheet
Dim strXLFile As String
Dim lngRow As Long
Dim lngCol As Long
Set db = CurrentDb
Set rsData = db.OpenRecordset("SELECT * FROM dbo_svr_Country ORDER BY CountryName ASC;", dbOpenDynaset, dbSeeChanges)
If Not (rsData.BOF And rsData.EOF) Then
strXLFile = "J:\downloads\transpose.xlsx"
If Len(Dir(strXLFile)) > 0 Then Kill strXLFile
Set objXLBook = objXL.Workbooks.Add
Set objXLSheet = objXLBook.Worksheets(1)
lngCol = 1
For lngRow = 1 To rsData.Fields.Count
objXLSheet.Cells(lngRow, lngCol) = rsData.Fields(lngRow - 1).name
Next lngRow
lngCol = 2
Do
For lngRow = 1 To rsData.Fields.Count
objXLSheet.Cells(lngRow, lngCol) = rsData.Fields(lngRow - 1).Value
Next lngRow
lngCol = lngCol + 1
rsData.MoveNext
Loop Until rsData.EOF
objXLBook.SaveAs strXLFile
End If
sExit:
On Error Resume Next
rsData.Close
Set rsData = Nothing
Set db = Nothing
Set objXLSheet = Nothing
objXLBook.Close
Set objXLBook = Nothing
objXL.Quit
Set objXL = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sExportExcelTransposed", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Regards,
Related
I am using Office 365 on a Windows 10 64-bit pc.
I have a Word document with a table into which I want to copy elements from an Excel document. The elements are a) text from its cell, b) a hyperlink from its cell and c) images from a list of images.
The first two tasks are performed successfully by the following sub:
Sub ImportFromExcel()
Dim RowNo As Long, RowTarget As Long
Dim RowFirst As Long, RowLast As Long
Dim strContent As String, strLink As String, strDisplay As String
Dim xlAppl As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Dim ExcelFileName As String
Dim tbl As Word.Table
On Error GoTo Finish
ExcelFileName = "C:\MyPath\MyExcelDoc.xlsm"
Set xlAppl = CreateObject("Excel.Application")
xlAppl.Application.Visible = False
xlAppl.Workbooks.Open ExcelFileName
Set xlBook = xlAppl.ActiveWorkbook
Set xlSheet = xlBook.Worksheets("Titan")
Set tbl = ActiveDocument.Tables(1)
RowFirst = 6: RowLast = 19
For RowNo = RowFirst To RowLast
RowTarget = RowNo - RowFirst + 1
strContent = xlSheet.Cells(RowNo, 5).Value
tbl.Cell(RowTarget, 1).Range.Text = strContent
strDisplay = xlSheet.Cells(RowNo, 3).Value
tbl.Cell(RowTarget, 3).Range.Text = strContent
strLink = xlSheet.Cells(RowNo, 3).Hyperlinks(1).Address
InsertHyperlinkInTable tbl, RowTarget, 3, strLink, strDisplay
' CopyImageFromExcelToWord xlSheet, RowTarget, tbl
Next RowNo
Finish:
xlAppl.ActiveWorkbook.Close False ' Word will not freeze at this point
xlAppl.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlAppl = Nothing
End Sub
I copy the hyperlink by reading its address and caption and then recreating it in Word.
Also from Word I can select a give image by way of its index using the first two active lines of the following sub:
Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
Dim strId As String
' Syntax at https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.select
strId = "Picture " & CStr(2 * imgNo)
xlSheet.Shapes.Range(Array(strId)).Select
' Missing link !
With tbl.Cell(1, 4)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.VerticalAlignment = wdCellAlignVerticalCenter
.Select
End With
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub
An image residing in the clipboard can be inserted into Word using the last six lines.
But I have not found out how to copy the image I selected in the Excel document to the clipboard with a Word macro.
Can this be done somehow?
Can the copying of the hyperlink be performed in a smarter way?
Try
Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
Dim strId As String
' Syntax at https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.select
strId = "Picture " & CStr(2 * imgNo)
xlSheet.Shapes.Range(Array(strId)).Item(1).Copy
With tbl.Cell(1, 4)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.VerticalAlignment = wdCellAlignVerticalCenter
.Range.PasteAndFormat wdFormatOriginalFormatting
End With
End Sub
Here is what I am trying to do:
Pick up SQL script from a worksheet(script has comments and queries)
Assign it to a string variable with the value of range of cells(where the scripts are pasted) from the worksheet
Execute the script by passing the string variable to ADODB connection I made before as a recordset
Paste the results of the script executed in the Oracle Database in a new sheet
So far what I have achieved:
Database connection was successful
I am able to assign the range values to a variant but not a string (Error: Type Mismatch)
If I change the variable to a variant then I am not able to execute it as a recordset.
(Error: arguments are of the wrong type, are out of acceptable range or are in conflict with one another)
I know the approach I am using is not that easy therefore I need suggestions on how I may be able to achieve this.
Private Sub RunValidation_Click()
Dim ws As Worksheet
Dim sheet As Variant
Dim StrSQL As Variant
Dim sheetnumber As Integer
Dim irow As Integer
Dim rs As ADODB.Recordset
Dim elementcount As Integer
Call OptimizeCode_Begin
Call Start_DBConnect
irow = ScriptExecutor.Range("A" & Rows.count).End(xlUp).row
elementcount = irow - 13
StrSQL = ScriptExecutor.Range("A14: A" & irow).Value
Set rs = New ADODB.Recordset
rs.Open StrSQL, cn, adOpenDynamic, adLockReadOnly, adCmdText
If Not rs.EOF Then
rs.MoveFirst
End If
i = 1
sheetnumber = Application.Sheets.count - i
Set ws = Sheets.Add(After:=Sheets(Sheets.count))
ws.name = "Extracts-" & sheetnumber
Sheets("Extracts-" & sheetnumber).Range("A2").CopyFromRecordset rs
rs.Close
Set rs = Nothing
End Sub
Try joining each row in the range with CRLF to create a string. The array assigned from the range is a single column with many rows. The JOIN function needs a single row many columns array hence the transpose function.
Dim StrSQL As String, arLines As Variant
arLines = ScriptExecutor.Range("A14: A" & irow).Value
StrSQL = Join(Application.Transpose(arLines), vbCrLf)
If you have to ignore the --comments including those on the same line as a statement (and the blank lines) then building the string one line at a time is probably the simplest method.
Dim cell As Range, sLine As String, StrSQL As String
With ScriptExecutor.Range("A14: A" & irow)
For Each cell In .Cells
sLine = Trim(cell.Value)
' remove any comments --
i = InStr(1, sLine, "--", vbTextCompare)
If i > 0 Then
sLine = Left(sLine, i - 1)
End If
If len(sLine) = 0 Then
' skip blank lines
Else
If Len(StrSQL) > 0 Then sLine = vbCrLf & sLine
StrSQL = StrSQL & sLine
End If
Next
End With
Debug.Print StrSQL
With multiple queries in the same script you get multiple record sets so try using .nextRecordSet method.
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Extracts-" & sheetnumber
Set rs = oCon.Execute(sql)
iRow = 2
Do Until rs Is Nothing
With ws
.Range("A" & iRow).CopyFromRecordset rs
iRow = .Range("A" & Rows.Count).End(xlUp).Row + 2
End With
Set rs = rs.nextRecordSet
Loop
I am able to achieve the above question with a slightly different approach. The only precondition is that the user will have to remove the comments from the script.
The script looks something like this:
Sample Script.
and the code is as follows:
Private Sub RunValidation_Click()
Dim ws As Worksheet
Dim sheet As Variant
Dim sheetnumber As Integer
Dim irow As Integer
Dim rs As ADODB.Recordset
Dim fld As ADODB.field
Dim elementcount As Integer
Dim sqlscript As Variant
Dim StrSQL As String
Dim commands As Variant
Dim cmd() As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim results As String
Dim rownum As Integer
Dim col As Integer
On Error GoTo UserForm_Initialize_Err
If ScriptExecutor.TextUser = vbNullString Then
MsgBox ("Please enter User ID.")
GoTo UserForm_Initialize_Exit
End If
If ScriptExecutor.TextPwd = vbNullString Then
MsgBox ("Please enter Password.")
GoTo UserForm_Initialize_Exit
End If
Call OptimizeCode_Begin
Call Start_DBConnect
' Figuring out the last row with data
irow = ScriptExecutor.Range("A" & Rows.count).End(xlUp).row
elementcount = irow - 13
' Assigning range to a Variant variable
sqlscript = ScriptExecutor.Range("A14: A" & irow).Value
'Converting into String
StrSQL = Join(Application.Transpose(sqlscript), vbCrLf)
' Break the script into semi-colon
commands = Split(StrSQL, ";")
' Transfer values from array with empty values to array with empty values in the end
ReDim cmd(0 To 0)
j = 0
For i = LBound(commands) To UBound(commands)
If commands(i) <> "" Then
j = j + 1
cmd(UBound(cmd)) = commands(i)
ReDim Preserve cmd(0 To UBound(cmd) + 1)
End If
Next i
'remove that empty array field at the end
If UBound(cmd) > 0 Then
ReDim Preserve cmd(0 To UBound(cmd) - 1)
End If
Set rs = New ADODB.Recordset
' Open new sheet to paste results
k = 2
sheetnumber = Application.Sheets.count - k
Set ws = Sheets.Add(After:=Sheets(Sheets.count))
ws.name = "Extracts-" & sheetnumber
' Copy results in new sheet with field names
rownum = 1
For i = LBound(cmd) To UBound(cmd)
rs.Open cmd(i), cn, adOpenDynamic, adLockOptimistic, adCmdText
rs.MoveFirst
col = 1
For Each fld In rs.Fields
With ws.Cells(rownum, col)
.Value = fld.name: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlTop: .EntireColumn.AutoFit: .Font.Bold = True: .Borders.Color = vbBlack
End With
col = col + 1
Next
rownum = ws.Range("A" & Rows.count).End(xlUp).row + 1
With ws.Range("A" & rownum)
.CopyFromRecordset rs:
.Borders.Color = vbBlack
rownum = ws.Range("A" & Rows.count).End(xlUp).row + 2
End With
rs.Close
Next
Set rs = Nothing
UserForm_Initialize_Exit:
On Error Resume Next
Call OptimizeCode_End
Call End_DBConnect
Exit Sub
UserForm_Initialize_Err:
MsgBox Err.number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume UserForm_Initialize_Exit
End Sub
This seems to be working perfectly at the moment but I am testing it with different scenarios.
To import data into an excel file, QueryTable is quite convenient when the source is a .csv file, e.g. Import csv with quoted newline using QueryTables in Excel , however it does not work with excel sources.
Importing an excel file can be done by VBA, just wonder, if there's something convenient as QueryTable, to import from a excel file, s.t. only need to specify the source file name, sheet name or range name?
Oh, I see. Ok, well, you can use VBA to import data from Worksheets into your Workbook.
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' assume range is A1 - C10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
targetSheet.Range("A1", "C10").Value = sourceSheet.Range("A1", "C10").Value
' Close customer workbook
customerWorkbook.Close
Or, you can use the Query tool to import data from another Excel file.
http://dailydoseofexcel.com/archives/2004/12/13/parameters-in-excel-external-data-queries/
I'm guessing you are importing data from Access into excel. I don't think you specified your source, or I couldn't make it out. My eyes are not as good as they used to be...
Anyway, consider this option.
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Or, this.
Sub RS2WS(rs As ADODB.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
If rs Is Nothing Then Exit Sub
If rs.State <> adStateOpen Then Exit Sub
If TargetCell Is Nothing Then Exit Sub
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Writing data from recordset..."
End With
With TargetCell.Cells(1, 1)
r = .Row
c = .Column
End With
With TargetCell.Parent
.Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear
' clear existing contents
' write column headers
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Name
On Error GoTo 0
Next f
' write records
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
Do While Not rs.EOF
r = r + 1
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Value
On Error GoTo 0
Next f
rs.MoveNext
Loop
.Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
.Columns("A:IV").AutoFit
End With
With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
I am creating an ADODB connection to a Sybase database, executing an SQL statement into a recordset, and then using the CopyFromRecordset method to paste the contents of the recordset to a range. This has been working fine but I recently moved PC's at work and now one of the columns is returning nothing.
When I run the same SQL in SQuirreL the column is not blank.
If I pause the VBA and try to look at one of the values in the column / field in question (ie ?rst.fields(1).value in the immediate Window) I get the following error message:
Run-time error '-2147467259 (80004005)': Unspecified error.
In the Squirrel results Metadata tab the column in question is described as:
ColumnIndex 2
getColumnName CommentText
getColumnTypeName text
getPrecision 2147483647
getScale 0
isNullable 0
getTableName xxxxxxx
getSchemaName
getCatalogName
getColumnClassName java.sql.Clob
getColumnDisplaySize 2147483647
getColumnLabel CommentText
getColumnType 2005
isAutoIncrement FALSE
isCaseSensitive FALSE
isCurrency FALSE
isDefinitelyWritable FALSE
isReadOnly FALSE
isSearchable FALSE
isSigned FALSE
isWritable TRUE
The code in question is below, but, as stated the code does not seem to be the problem as it has worked previously - any ideas?
Sub ImportComments()
Dim wsData As Worksheet
Dim rng As Range
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim x As Long
Dim rngSQL As Range
Dim cell As Range
Dim sSQL As String
Dim sProvider As String
Dim sDS As String
Dim sDataSource As String
Dim sUser As String
Dim sCatalog As String
Dim sPassword As String
Dim rngDS As Range
Dim rngThisDS As Range
Dim sConnect As String
Dim sInstance As String
Dim fSuccess As Boolean
Dim sError As String
On Error GoTo ProcExit
'delete previous comments if they exist
If SheetExists("Comments_Data_Import", ThisWorkbook) = True Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Comments_Data_Import").Delete
Application.DisplayAlerts = True
End If
'create comments sheet
Set wsData = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets("EWI_Data_Import"))
wsData.Name = "Comments_Data_Import"
'build sql string
Set rngSQL = Range(ThisWorkbook.Sheets("SQL").Range("A2"), _
ThisWorkbook.Sheets("SQL").Range("A2").End(xlDown))
For Each cell In rngSQL
sSQL = sSQL & cell.Value & " "
Next cell
'define login components
Set rngDS = ThisWorkbook.Worksheets("Login").Range("rngInstance").CurrentRegion
Set rngDS = rngDS.Offset(1, 0).Resize(rngDS.Rows.Count - 1)
sProvider = "Provider=ASEOLEDB.1;"
sUser = "User ID=" & ThisWorkbook.Worksheets("Login").Range("rngUsername").Value & ";"
sPassword = "Password=" & ThisWorkbook.Worksheets("Login").Range("rngPassword").Value
'try to log in to each instance exiting when succesful
Set cn = New ADODB.Connection
cn.CommandTimeout = 600
'turn off error hadling to allow for connection errors On Error Resume Next
For Each rngThisDS In rngDS.Rows
'complete connect string
Err = 0
sInstance = rngThisDS.Cells(1, 1)
sDS = "Data Source=" & rngThisDS.Cells(1, 2) & ";"
sCatalog = "Initial Catalog=" & rngThisDS.Cells(1, 3) & ";"
sConnect = sProvider & sDS & sUser & sCatalog & sPassword
'attempt to open
cn.Open sConnect
'If successful Then
If Err = 0 Then
'flag success
fSuccess = True
'execute SQL
On Error GoTo ProcError
Set rst = cn.Execute(sSQL)
'copy data into comments sheet
wsData.Range("A2").CopyFromRecordset rst
'Put in the headers
Set rng = wsData.Range("A1")
For x = 1 To rst.Fields.Count
rng.Offset(0, x - 1).Value = rst.Fields(x - 1).Name
Next x
FormatComments
Exit For
End If
Next rngThisDS
If fSuccess = False Then
MsgBox ("Unable to connect to Insight")
Else
MsgBox "Connected to and exported data from " & sInstance
End If
ProcExit:
Set wsData = Nothing
Set rng = Nothing
Set cn = Nothing
Set rst = Nothing
Set rngSQL = Nothing
Set cell = Nothing
Set rngDS = Nothing
Set rngThisDS = Nothing
Exit Sub
ProcError:
MsgBox "Error: " & Err.Description
Resume ProcExit
End Sub
According to the CopyFromRecordset() MSDN:
When this method copies the recordset to the worksheet, the results
will be truncated if you do not specify a range that is large enough
to hold the contents of the recordset.
Consider specifying the range with MoveFirst command reset:
' Copy data into comments sheet
rst.MoveLast
rst.MoveFirst
wsData.Range("A2:Z500").CopyFromRecordset rst
Or entire worksheet (starting at A1, of course inserting row for column headers)
wsData.Cells.CopyFromRecordset rst
But even then, CopyFromRecordset() is sensitive to data and cursory types even memory (since you pull all data and dump at once), so consider altogether replacing the method and iterate through records for the rows. Even other languages (PHP, Python, Java, etc.) run queries this way, opening cursor and iterating through resultset.
' Put in the headers
Set rng = wsData.Range("A1")
For x = 1 To rst.Fields.Count
rng.Offset(0, x - 1).Value = rst.Fields(x - 1).Name
Next x
' Put in rows
Dim col As Integer, row As Integer
rst.MoveLast
rst.MoveFirst
Set rng = wsData.Range("A2")
row = 0
Do While Not rst.EOF
For col = 0 To rst.Fields.Count - 1
rng.Offset(row, col).Value = rst(col)
Next col
row = row + 1
rst.MoveNext
Loop
i made a program to read an excel document and display it on a messageBox. but, the thing is, i want to scrap aka display all of it to messageBox without knowing which row or column to choose. i wrote this code:
Private Sub Command1_Click()
On Error GoTo Err
StartExcel
Set ExcelWBk = Excel.Workbooks.Open(App.Path & "\Dataku.xls")
Set ExcelWS = ExcelWBk.Worksheets(1)
With ExcelWS
Dim i As Integer
Dim strData As String
For i = 1 To 5
strData = strData & .Cells(i, 1) & vbCrLf
Next i
End With
MsgBox strData
CloseWorkSheet
ClearExcelMemory
Exit Sub
Err:
ClearExcelMemory
End Sub
but it returned into datas of that column (column 1) only. i need to read whole excel file.
Something like this (tested in PowerPoint as I dont have VB6) will get the UsedRange of the first sheet cell by cell (using an array for efficiency)
Pls change your file path to suit.
First version - tested in PowerPoint
Sub GetData()
Dim objExcel As Object
Dim objWB As Object
Dim objws As Object
Dim X As Variant
Dim lngCol As Long
Dim lngRow As Long
Dim strOut As String
Set objExcel = CreateObject("Excel.Application")
On Error Resume Next
Set objWB = objExcel.Workbooks.Open("c:\temp\test.xlsx")
Set objws = objWB.Sheets(1)
On Error GoTo 0
If objws Is Nothing Then Exit Sub
'recalc usedrange
objws.usedrange
X = objws.usedrange
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
strOut = strOut & (X(lngRow, lngCol) & vbNewLine)
Next
Next
objWB.Close False
objExcel.Quit
Set objExcel = Nothing
If Len(strOut) > 0 Then MsgBox strOut
End Sub
VBS version
Dim objExcel
Dim objWB
Dim objws
Dim X
Dim lngCol
Dim lngRow
Dim strOut
Set objExcel = CreateObject("Excel.Application")
On Error Resume Next
Set objWB = objExcel.Workbooks.Open("c:\temp\test.xlsx")
Set objws = objWB.Sheets(1)
On Error GoTo 0
If IsEmpty(objws) Then Stop
'recalc usedrange
objws.usedrange
X = objws.usedrange
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
strOut = strOut & (X(lngRow, lngCol) & vbNewLine)
Next
Next
objWB.Close False
objExcel.Quit
Set objExcel = Nothing
If Len(strOut) > 0 Then MsgBox strOut