Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

opening excell with wrong filename problem

Status
Not open for further replies.

grobbu

Programmer
Jun 25, 2002
40
BE
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 quite don't understand why you're using Word stuff with Excel ...
Having On Error Resume Next allways active hide all the bad coding ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
huh?
what u mean please?
u mean this line:
' Set Appwd = GetObject(, "Word.Application")

Forget it..i overlooked it before. it's there for no reason and deleted from the code.
That's why the ' is in front of it...
But you're right..it should have been deleted already.

But no idea for the actual problem?

grtz
ixpee
 
You really don't see that you have posted many lines of Word VBA code ?
For example, from here:
.Documents.Add Template:=Chr(34) & TotaleSjabloonPath & Chr(34)
to here:
.ActiveDocument.Saved = True

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
...when excel opens a file with a number appended to it, it usually means that you opened it from a template (xlt). And, yes there is a lot of word code present. You probably would be better of cleaning this up (echt waar).
 
tx for the quick response PHV

And I have to admit..i don't see.
This is my first vba coding where I have to work with excell and create open and edit some things.
I created this code by searching a lot on this site ..but now it seems that that wasn't to correct at all:(

Strange thing is that the code from which u say it is WORD vba code..opens and creates my excell file from a template and saves it...

Can u help me out please...?I reall don't know what to do anymore...
 
Tip: when in excel do what you want manually with the macrorecorder running.
Then examine the generated code to discover the syntax.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
tx for all the reply again PHV!

In fact problem isn't with creating file from template...
that part works..
Problem is when I reopen a created file from within vba. there's always added a 1 to the original file.
When i open file in explorer and save it and afterwards try it with vba..all works..
!?!
I dont understand it anymore:(

grtz
ixpee
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top