
27-01-16, 08:54
|
| Όνομα: Θάνος Έκδοση λογισμικού Office: Ms-Office 2007 Γλώσσα λογισμικού Office: Ελληνική | | Εγγραφή: 09-05-2012 Περιοχή: Λάρισα
Μηνύματα: 49
| |
Access error 429 activex component cant create
Καλημέρα παιδιά
Δεν θυμάμαι κάποιος απο εδω μέσα, μου είχε κάνει τον κώδικα για export σε excel,
εκανα κάποιες αλλαγές στο τελικό αρχείο και μου βγάζει το error 429
εκανα ερευνα, λένε οτι υπάρχει περίπτωση για corrupt του excel. (Χρησιμοποιώ access 2007 και excel αντίστοιχα)
Ο Κώδικας έιναι ο παρακάτω: Παράθεση:
Private Sub btnExcelExport_Click()
Dim rs As DAO.Recordset
Dim rsCount As Long
Dim i, icount As Integer
'Dim rHeight As single
Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim wks As Excel.Worksheet
'Dim rngTotalRow As Single'
Dim MySheetPath As String
Dim MySQL As String
MySQL = "SELECT Preorder.numberid,Preorder.preorderdate,PreorderDe tails.PreorderDetailDescription,Preorder.approvalt ext1, "
MySQL = MySQL & "PreorderDetails.Price,Preorderdetails.quantit y, "
'MySQL = MySQL & "Preorder.Approved,PreorderDetails.Price,Preorderd etails.quantity, "
MySQL = MySQL & "Preorderdetails.UOM FROM Preorder INNER JOIN PreorderDetails "
MySQL = MySQL & "ON Preorder.PreorderID = PreorderDetails.PreorderID WHERE "
MySQL = MySQL & "Preorder.PreorderID =" & Me!PreorderID & " AND Preorder.Approved=true"
Set rs = CurrentDb.OpenRecordset(MySQL, dbOpenSnapshot)
MySheetPath = "E:\PREORDERS\sxediofinal.xls"
If rs.RecordCount Then
rs.MoveLast
rs.MoveFirst
rsCount = rs.RecordCount
On Error GoTo ExitHere
Set xl = CreateObject("Excel.Application")
Set xlWB = GetObject(MySheetPath)
xlWB.Windows(1).Visible = True
xl.Visible = True
Set wks = xlWB.Worksheets(1)
wks.Range("Q2") = Nz(rs!NumberID, "")
wks.Range("Q5") = Nz(rs!ApprovalText1, "")
wks.Range("Q1") = Nz(rs!PreorderDate, "")
Set rngTotalRow = wks.Range("D14:D23")
If rsCount > 4 Then
With rngTotalRow
rHeight = .RowHeight
For i = 1 To rsCount - 4
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Offset(-1).RowHeight = rHeight
.Offset(-2).AutoFill Destination:=wks.Range(.Offset(-2), .Offset(-1)), Type:=xlFillFormats
.RowHeight = rHeight
Next
End With
End If
i = 14
icount = 1
While Not rs.EOF
wks.Range("A" & i) = icount
wks.Range("D" & i) = Nz(rs!PreorderDetailDescription, "")
If rs!UOM = "ôåì" Then
wks.Range("J" & i) = Nz(rs!Quantity, 0)
Else
wks.Range("I" & i) = Nz(rs!Quantity, 0)
End If
wks.Range("K" & i) = Nz(rs!Price, 0)
rs.MoveNext
i = i + 1
icount = icount + 1
Wend
ExitHere:
If Err <> 0 Then
MsgBox "Error: " & Err & vbLf & Err.Description, vbExclamation
End If
rs.Close
Set rs = Nothing
If Not xlWB Is Nothing Then Set xlWB = Nothing
End If
End Sub
| Ευχαριστώ
[
|