Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old December 23rd, 2010, 11:49 AM
Registered User
 
Join Date: Dec 2010
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Smile Excel problem-"Target table is not in correct format"

I Have one Excel temaplate which is some thing like abc.xltx which have some columns etc. Now i am copying the template data to excel 2007 which is bcd.xlsx.

for this connection string i used is
conXL.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sDestFileName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"";"

the whole code will be like this

Private Function CreateXLSADO(sReportFile As String, ByRef sOutputFile As String) As Boolean

On Error GoTo LocalErr

Dim sDestPath As String, sDestFile As String, sTemplatePath As String
Dim sUserID_NoDomain As String

Randomize

''''RJK 24-Apr-03: If sReportFile is absolute path then forget the template directory.
If IsAbsolutePath(sReportFile) Then
sTemplatePath = ""
Else
sTemplatePath = GetTemplateDirectory()
End If

''''RJK 06-Mar-03: default the file extension to .xlt if it doesn't exist.
If Dir(sTemplatePath & sReportFile) = "" And Right(sReportFile, 4) <> ".xltx" Then
sReportFile = sReportFile & ".xltx"
End If
''''RJK 21-Feb-03: verify that the template exists
If Dir(sTemplatePath & sReportFile) = "" Then
Err.Raise eERROR_TEMPLATE_FILE_DOES_NOT_EXIST, "", "Template file does not exist: " & sTemplatePath & sReportFile
End If

If sOutputFile = "" Then
sDestPath = GetOutputDirectory()

''''use the Rnd() function to generate a somewhat unique number. This is needed to prevent
'''' caching of reports. The user's reports are deleted prior to each session login, so the
'''' chances of dupes is minimized
'''' RJK 06-Mar-03: Deal with backslash in UserId (eg nt domain).
'''' Just uses everything to the right of the rightmost backslash.
sUserID_NoDomain = ToString(m_UserId)
sUserID_NoDomain = Right(sUserID_NoDomain, Len(sUserID_NoDomain) - InStrRev(sUserID_NoDomain, "\", , vbTextCompare))
sDestFile = Replace(sUserID_NoDomain & "_" & m_ReportAbbreviation & CStr(CInt(1000 * Rnd())) & ".xlsx", " ", "_")

On Error Resume Next
''''try to create the temp path
If Dir(sDestPath, vbDirectory) = "" Then MkDir sDestPath
On Error GoTo LocalErr
Else
'''' Set these variables so (sDestPath & sDestFile) always produces the right result.
sDestPath = ""
sDestFile = sOutputFile
End If

On Error Resume Next
If Dir(sDestPath & sDestFile) <> "" Then
''''the file already exists, attempt to delete it
SetAttr sDestPath & sDestFile, vbNormal
Kill sDestPath & sDestFile
End If
On Error GoTo LocalErr

''''call the GenerateExcelADOReport function
If GenerateExcelADOReport(sTemplatePath & sReportFile, sDestPath & sDestFile) And Connected Then

sOutputFile = sDestFile '''' If sOutputFile already had a value this will not change it

CreateXLSADO = True
Else
CreateXLSADO = False
Err.Raise eERROR_GENERATING_REPORT, "", "GenerateExcelADOReport failed."
End If

CleanUp:

Exit Function


The above function is checking whether template having .xltx or not ,if having creating the destination file with .xlsx.

and passing the both to below function



Public Function GenerateExcelADOReport(sReportFile As String, sDestFileName As String) As Boolean
On Error GoTo LocalErr

Dim conXL As Connection, rsXL As Recordset
Dim rs As Recordset, rsSub As Recordset

Dim iSubReports As Integer, i As Integer
Dim aSubReports() As String

Dim sParam As String
Dim sErr As String
Dim e As ADODB.Error

Dim sStart As Single

Dim lErrNumber As Long
Dim sErrSource As String
Dim sErrDescription As String

sStart = Timer

''''make a copy of the template file (the calling procedure has already made sure it's not already there)
FileCopy sReportFile, sDestFileName

''''create and open a new ADO Connection
Set conXL = New ADODB.Connection
''''HDR=Yes means that the subsequent recordsets will use the first row in the named range as the field list
'conXL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=" & sDestFileName & ";" & _
' "Extended Properties=""Excel 8.0;HDR=Yes;"";"

conXL.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sDestFileName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"""


''''RJK 21-Feb-03: Don't treat "main" as (very) special. Add it as the first
''''"subreport" in case it's not listed in the subreports range, but then
''''deal with it as with other dataranges.
iSubReports = iSubReports + 1
ReDim Preserve aSubReports(1 To iSubReports)
aSubReports(iSubReports) = "main"

''''need to load sub-reports (if supplied)
On Error Resume Next
Set rsXL = New ADODB.Recordset
rsXL.Open "select * from subreports", conXL, adOpenStatic, adLockOptimistic
If Err <> 0 Then Set rsXL = Nothing
On Error GoTo LocalErr

If Not rsXL Is Nothing And Connected Then
''''get a listing of sub-reports
Do Until rsXL.EOF
''''RJK 21-Feb-03: Don't add main, as we've already added it manually.
If rsXL(0) <> "main" Then
iSubReports = iSubReports + 1
ReDim Preserve aSubReports(1 To iSubReports)

aSubReports(iSubReports) = rsXL(0)
End If
rsXL.MoveNext
Loop
rsXL.Close
End If

''''see if there are any sub-reports
If iSubReports > 0 And Connected Then
For i = 1 To iSubReports
Set rsSub = Nothing
'''''see if there is a matching sub-report data set
If Exists(aSubReports(i), m_Data) Then
Set rsSub = m_Data(aSubReports(i))
End If

If Not rsSub Is Nothing Then
''''need to open the sub-report range
Set rsXL = New ADODB.Recordset
rsXL.Open "select * from " & aSubReports(i), conXL, adOpenStatic, adLockOptimistic

PopulateExcelReport aSubReports(i), rsSub, rsXL, conXL, sErr
''''if there was error populating the report, cleanup & bail
If sErr <> "" Then GoTo CleanUp

End If

If Not Connected Then Exit For
Next i ''''next sub-report
End If

On Error Resume Next
''''load parameters (if supplied) from the parameterList named range
Set rsXL = New ADODB.Recordset
rsXL.Open "select * from parameterList", conXL, adOpenStatic, adLockOptimistic
If (Err <> 0) Then Set rsXL = Nothing
On Error GoTo LocalErr

If Not rsXL Is Nothing And Connected Then
''''loop through the parameter values and set the parameter values
Do Until rsXL.EOF
''''get the param name
'''' RJK 25-Mar-03: Added check that name isn't empty or null
sParam = ToString(rsXL("Name"))
If sParam = "" Then
Err.Raise eERROR_IN_TEMPLATE, "", "Empty parameter name in parameterList range."
End If

''''update the param values
rsXL("Value") = ResolveParameter(sParam)
rsXL.Update

''''move on to the next param
rsXL.MoveNext
Loop

''''close the rs
rsXL.Close
End If

If Not Runtime Then LogEvent "Took " & Format(Timer - sStart, "0.00") & " seconds to generate report."

''''return true
GenerateExcelADOReport = True

CleanUp:
On Error Resume Next

If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
If Not rsSub Is Nothing Then If rsSub.State = adStateOpen Then rsSub.Close
Set rsSub = Nothing
If Not rsXL Is Nothing Then If rsXL.State = adStateOpen Then rsXL.Close
Set rsXL = Nothing
If Not conXL Is Nothing Then If conXL.State = adStateOpen Then conXL.Close
Set conXL = Nothing

On Error GoTo LocalErr

If Not GenerateExcelADOReport Then
Err.Raise eERROR_GENERATING_REPORT, "", sErr
End If

Exit Function

This function is copying the template structure to excel file and then by using connection string importing datat to the Excel.

But near connection string i am getting the problem?

The problem is Source: microsoft office access database engine and external table is not in correct format

Please solve this issue as soon as problem . . .
 
Old December 23rd, 2010, 04:34 PM
Friend of Wrox
 
Join Date: Jun 2008
Posts: 1,649
Thanks: 3
Thanked 141 Times in 140 Posts
Default

Ummm...this has nothing to do with ASP.

Maybe a moderator could move it to an Excel or VBA forum?
 
Old January 14th, 2011, 03:21 PM
jminatel's Avatar
Wrox Staff
Points: 18,059, Level: 58
Points: 18,059, Level: 58 Points: 18,059, Level: 58 Points: 18,059, Level: 58
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: May 2003
Posts: 1,906
Thanks: 62
Thanked 139 Times in 101 Posts
Default

Moved to a better forum for the topic. :)
__________________
Jim Minatel
Associate Publisher, WROX - A Wiley Brand
Did someone here help you? Click on their post!





Similar Threads
Thread Thread Starter Forum Replies Last Post
MSXSL gives error message for "for" inside "select" ilyaz XSLT 1 December 9th, 2010 05:02 PM
"Conversion to Dalvik format failed with error 1" egg86 BOOK: Professional Android 2 Application Development 1 September 24th, 2010 03:11 PM
How to theme the "Browse" button of "FileUpload" control? varunbwj BOOK: Beginning ASP.NET 3.5 : in C# and VB BOOK ISBN: 978-0-470-18759-3 2 October 14th, 2009 01:22 AM
Add a CheckBox DataColumn to my DataGridView, Null format: "" or "True" but Error: F ismailc C# 2005 0 September 25th, 2009 04:56 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.