-
External 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
Code:
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
Code:
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
Code:
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?
Please solve this issue as soon as problem . . .
Similar Threads
-
By kenn_rosie in forum .NET
Replies: 2
Last Post: 01-11-2006, 10:28 AM
-
Replies: 0
Last Post: 04-04-2003, 06:13 PM
-
By ewarmour in forum ASP.NET
Replies: 0
Last Post: 03-27-2003, 02:36 PM
-
By mdengler in forum ASP.NET
Replies: 0
Last Post: 11-26-2002, 03:32 PM
-
By Anouar in forum Database
Replies: 1
Last Post: 07-27-2000, 08:25 AM
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Development Centers
-- Android Development Center
-- Cloud Development Project Center
-- HTML5 Development Center
-- Windows Mobile Development Center
|