hi all
i got a problem when i try to open an excell file i made with my application.
lets say i create an excell file from a template fill in some text and let it call file123.xls
Later i open this file but excell opens it as file1231.xls.
Anybody an idea?
code to create file:
*******************************************
Dim prompt
Dim title
Dim style
Dim response
Dim i As Long
Dim xlObject As Object
Dim xlSheet As Object 'Worksheet Object
Dim xlWindow As Excel.Window
Dim currentWorksheet As Excel.Worksheet
Dim TotaleFilePath As String
Dim TotaleSjabloonPath As String
Function Excel_Openen()
If File_exist(TotaleFilePath) Then
title = "Waarschuwing"
style = vbCritical + vbYesNo
response = MsgBox("already exists" & vbCrLf & "overwrite?", style, title)
If response = vbNo Then
Exit Function
End If
End If
On Error Resume Next
Set xlObject = GetObject(TotaleSjabloonPath)
xlObject.SaveAs TotaleFilePath
xlObject.Parent.Visible = True
For Each xlWindow In xlObject.Windows
xlWindow.Visible = True
Next
xlObject.Saved = True
'Me.cmdSjabloonOpenen.Visible = False
Me.cmdSluiten.Visible = True
' Set Appwd = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set xlObject = GetObject(TotaleSjabloonPath)
Else
End If
Me.Mededeling.Visible = False
Bewaard = True
With xlObject
'------------------------------------
'- Openen van het juiste sjabloon -
'------------------------------------
.Documents.Add Template:=Chr(34) & TotaleSjabloonPath & Chr(34)
.Selection.WholeStory
Select Case Me.cp_ID.Column(7)
Case 1 To 4: .Selection.LanguageID = wdDutch
Case 5 To 8: .Selection.LanguageID = wdEnglishUK
Case 9 To 12: .Selection.LanguageID = wdGerman
Case 13 To 20: .Selection.LanguageID = wdFrench
End Select
'------------------------------------------------
'- Updaten van de velden in het Word-document -
'------------------------------------------------
.Selection.Fields.Update
Dim tempSjabloon As String
tempSjabloon = Me.lstSjablonen.Column(1)
If tempSjabloon = "0000Euro Calculatie" Then
Eurocalculatie
End If
If tempSjabloon = "000000SS EINDLOOS EURO" Then
EINDLOOSEURO
End If
If tempSjabloon = "Service jabloon" Then
Servicesjabloon
End If
.ActiveWindow.ActivePane.Close
.ActiveWindow.ActivePane.View.Type = wdPageView
.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
.Selection.EndOf unit:=wdParagraph, Extend:=wdMove
.Visible = True
'----------------------------------------
'Het window wordt gemaximaliseerd -
'----------------------------------------
.WindowState = wdWindowStateMaximize
.Activate
'--------------------------------------------
'- Bepalen van de bestandslocatie en naam -
'--------------------------------------------
.ActiveDocument.SaveAs Chr$(34) & TotaleFilePath & Chr$(34)
.ActiveDocument.Saved = True
.Activate
Set xlSheet = Nothing
Set xlWindow = Nothing
xlObject.Quit
Set xlObject = Nothing
Exit Function
End With
End Function
Private Sub Eurocalculatie()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(1, 1) = "CUSTOMER : " & Me.Bedrijfnaam.Column(14)
.Cells(2, 1) = "AANVRAAG No : " & Me.Offertenummer
.Cells(4, 1) = "CALCULATOR : " & getMedewerkerNaam 'function to get username
End With
End Sub
Private Sub EINDLOOSEURO()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(1, 1) = "CUSTOMER : " & Me.Bedrijfnaam.Column(14)
.Cells(2, 1) = "AANVRAAG No : " & Me.Offertenummer
.Cells(4, 1) = "CALCULATOR : " & getMedewerkerNaam 'function to get username
End With
End Sub
Private Sub Servicesjabloon()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(3, 3) = Date
.Cells(4, 3) = Me.Bedrijfnaam.Column(14)
.Cells(5, 3) = Me.doc_OnzeRef
.Cells(6, 3) = Me.doc_YourRef
.Cells(8, 3) = Me.doc_Omschrijving
.Cells(9, 3) = Me.doc_AanmaakDatum
.Cells(12, 3) = getMedewerkerNaam 'function to get username
End With
End Sub
code to open excel file:
*******************************************
Dim stDocName As String
Dim stLinkCriteria As String
Dim FileString As String
Dim prompt
Dim title
Dim style
Dim response
Function Excel_Openen()
FileString = Me.doc_Bestandslocatie & Me.doc_Bestandsnaam
If Not File_exist(FileString) Then
title = "Bestand niet gevonden"
style = vbInformation + vbYesNo
prompt = "Dit bestand bestaat niet meer" & Chr$(13) & Chr$(13) 'excists?
prompt = prompt & "Wilt u dit bestand uit het systeem verwijderen?" 'remove?
response = MsgBox(prompt, style, title)
If response = vbYes Then
DoCmd.RunSQL "DELETE * From tblDocument Where doc_ID = " & Me.doc_ID
Me.Requery
Exit Function
Else
Exit Function
End If
End If
' Excel objects (using late binding)
Dim xl As Object ' Excel.Application
Dim wrk As Object ' Excel.Workbook
Dim ws As Object ' Excel.Worksheet
On Error Resume Next
' Getting open Excel instance, if exists
Set xl = GetObject(, "Excel.Application")
xl.Quit
If (Err.Number <> 0) Then
Err.Clear
' - else crating an instance
Set xl = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
' If it can't open an instance of Excel, then...
MsgBox "Ouch"
Exit Function
End If
End If
xl.DisplayAlerts = False
xl.Visible = False
xl.ScreenUpdating = False
Set wrk = xl.Workbooks.Open(FileString)
Set ws = wrk.Worksheets(1)
If (Not (xl Is Nothing)) Then
xl.Visible = True
xl.DisplayAlerts = True
xl.ScreenUpdating = True
End If
Set ws = Nothing
Set wrk = Nothing
Set xl = Nothing
Exit Function
End Function
Hope its clear to you..if not..ask please..
some dutch in it.
And more hope somebody can help me with my problem...
why is file 123 later opened as file 1231...!?ç
greetz and tx already for reading.
Hope u got answers too
i got a problem when i try to open an excell file i made with my application.
lets say i create an excell file from a template fill in some text and let it call file123.xls
Later i open this file but excell opens it as file1231.xls.
Anybody an idea?
code to create file:
*******************************************
Dim prompt
Dim title
Dim style
Dim response
Dim i As Long
Dim xlObject As Object
Dim xlSheet As Object 'Worksheet Object
Dim xlWindow As Excel.Window
Dim currentWorksheet As Excel.Worksheet
Dim TotaleFilePath As String
Dim TotaleSjabloonPath As String
Function Excel_Openen()
If File_exist(TotaleFilePath) Then
title = "Waarschuwing"
style = vbCritical + vbYesNo
response = MsgBox("already exists" & vbCrLf & "overwrite?", style, title)
If response = vbNo Then
Exit Function
End If
End If
On Error Resume Next
Set xlObject = GetObject(TotaleSjabloonPath)
xlObject.SaveAs TotaleFilePath
xlObject.Parent.Visible = True
For Each xlWindow In xlObject.Windows
xlWindow.Visible = True
Next
xlObject.Saved = True
'Me.cmdSjabloonOpenen.Visible = False
Me.cmdSluiten.Visible = True
' Set Appwd = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set xlObject = GetObject(TotaleSjabloonPath)
Else
End If
Me.Mededeling.Visible = False
Bewaard = True
With xlObject
'------------------------------------
'- Openen van het juiste sjabloon -
'------------------------------------
.Documents.Add Template:=Chr(34) & TotaleSjabloonPath & Chr(34)
.Selection.WholeStory
Select Case Me.cp_ID.Column(7)
Case 1 To 4: .Selection.LanguageID = wdDutch
Case 5 To 8: .Selection.LanguageID = wdEnglishUK
Case 9 To 12: .Selection.LanguageID = wdGerman
Case 13 To 20: .Selection.LanguageID = wdFrench
End Select
'------------------------------------------------
'- Updaten van de velden in het Word-document -
'------------------------------------------------
.Selection.Fields.Update
Dim tempSjabloon As String
tempSjabloon = Me.lstSjablonen.Column(1)
If tempSjabloon = "0000Euro Calculatie" Then
Eurocalculatie
End If
If tempSjabloon = "000000SS EINDLOOS EURO" Then
EINDLOOSEURO
End If
If tempSjabloon = "Service jabloon" Then
Servicesjabloon
End If
.ActiveWindow.ActivePane.Close
.ActiveWindow.ActivePane.View.Type = wdPageView
.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
.Selection.EndOf unit:=wdParagraph, Extend:=wdMove
.Visible = True
'----------------------------------------
'Het window wordt gemaximaliseerd -
'----------------------------------------
.WindowState = wdWindowStateMaximize
.Activate
'--------------------------------------------
'- Bepalen van de bestandslocatie en naam -
'--------------------------------------------
.ActiveDocument.SaveAs Chr$(34) & TotaleFilePath & Chr$(34)
.ActiveDocument.Saved = True
.Activate
Set xlSheet = Nothing
Set xlWindow = Nothing
xlObject.Quit
Set xlObject = Nothing
Exit Function
End With
End Function
Private Sub Eurocalculatie()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(1, 1) = "CUSTOMER : " & Me.Bedrijfnaam.Column(14)
.Cells(2, 1) = "AANVRAAG No : " & Me.Offertenummer
.Cells(4, 1) = "CALCULATOR : " & getMedewerkerNaam 'function to get username
End With
End Sub
Private Sub EINDLOOSEURO()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(1, 1) = "CUSTOMER : " & Me.Bedrijfnaam.Column(14)
.Cells(2, 1) = "AANVRAAG No : " & Me.Offertenummer
.Cells(4, 1) = "CALCULATOR : " & getMedewerkerNaam 'function to get username
End With
End Sub
Private Sub Servicesjabloon()
Set xlSheet = xlObject.ActiveSheet
With xlSheet
.Cells(3, 3) = Date
.Cells(4, 3) = Me.Bedrijfnaam.Column(14)
.Cells(5, 3) = Me.doc_OnzeRef
.Cells(6, 3) = Me.doc_YourRef
.Cells(8, 3) = Me.doc_Omschrijving
.Cells(9, 3) = Me.doc_AanmaakDatum
.Cells(12, 3) = getMedewerkerNaam 'function to get username
End With
End Sub
code to open excel file:
*******************************************
Dim stDocName As String
Dim stLinkCriteria As String
Dim FileString As String
Dim prompt
Dim title
Dim style
Dim response
Function Excel_Openen()
FileString = Me.doc_Bestandslocatie & Me.doc_Bestandsnaam
If Not File_exist(FileString) Then
title = "Bestand niet gevonden"
style = vbInformation + vbYesNo
prompt = "Dit bestand bestaat niet meer" & Chr$(13) & Chr$(13) 'excists?
prompt = prompt & "Wilt u dit bestand uit het systeem verwijderen?" 'remove?
response = MsgBox(prompt, style, title)
If response = vbYes Then
DoCmd.RunSQL "DELETE * From tblDocument Where doc_ID = " & Me.doc_ID
Me.Requery
Exit Function
Else
Exit Function
End If
End If
' Excel objects (using late binding)
Dim xl As Object ' Excel.Application
Dim wrk As Object ' Excel.Workbook
Dim ws As Object ' Excel.Worksheet
On Error Resume Next
' Getting open Excel instance, if exists
Set xl = GetObject(, "Excel.Application")
xl.Quit
If (Err.Number <> 0) Then
Err.Clear
' - else crating an instance
Set xl = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
' If it can't open an instance of Excel, then...
MsgBox "Ouch"
Exit Function
End If
End If
xl.DisplayAlerts = False
xl.Visible = False
xl.ScreenUpdating = False
Set wrk = xl.Workbooks.Open(FileString)
Set ws = wrk.Worksheets(1)
If (Not (xl Is Nothing)) Then
xl.Visible = True
xl.DisplayAlerts = True
xl.ScreenUpdating = True
End If
Set ws = Nothing
Set wrk = Nothing
Set xl = Nothing
Exit Function
End Function
Hope its clear to you..if not..ask please..
some dutch in it.
And more hope somebody can help me with my problem...
why is file 123 later opened as file 1231...!?ç
greetz and tx already for reading.
Hope u got answers too