Office: Tabelle speichern unter Namen von TextBox1

Hallo Zusammen,

ich brauche eure Hilfe.
Erstmal, es ist Excel 2003. Hier der Code

Sub Email_an_ADM_senden()

Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim aws As String
Dim Sh As Shape

Application.ScreenUpdating = False


'Kopiert aktuelles Sheet in eine neue Mappe welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel

For Each Sh In ActiveSheet.Shapes
If TypeName(Sh.OLEFormat.Object) = "Button" Then Sh.Delete
Next

ActiveWorkbook.SaveAs Filename:="\\de.root.net\Dfs-data\man-teams\Vkid\Infothek\Neukunden an ADM" & "\" & TextBox1 & Format(Now, "ddmmyy_hhmm") & ".xls"

With ActiveWorkbook
aws = .FullName
.Close
End With
'InitializeOutlook
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.GetInspector
'Mailadresse An
.to = "ADM HIER EINTRAGEN"
'Hier wird die temporär gespeicherte Datei als Attachment zugefügt
.Subject = "Neukunde " & Sheets(7).TextBox1 & " " & "aus" & " " & Sheets(7).TextBox4 & " " & "aufgenommen am " & Date & " um " & Time & " Uhr"
'Hier wird der Betreff eingefügt
.Attachments.Add aws
'Hier wird die Mail nochmals angezeigt
.display
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing

Application.ScreenUpdating = True

Call TextFelderLeeren
'Hier wird das original Formular geleert

End Sub
Sub TextFelderLeeren()
Dim tbx As OLEObject
For Each tbx In ActiveSheet.OLEObjects
If TypeName(tbx.Object) = "TextBox" Then
tbx.Object.Text = ""
End If
Next
End Sub

Ist Situation:
Er kopiert mir das aktuelle Tabellenblatt und speichert es unter dem o.a. Pfad mit dem Dateinamen als aktuelle Zeit.
Ich möchte aber, dass er mir das Tabellenblatt mit dem Namen speichert, dass in der Textbox1 angegeben worden ist, so wie es weiter unten ist (Betreff). Heißt, Dateiname soll sein wie die Betreffzeile die ich dann per Mail versende.

Danke für eure Hilfe

 

Moinsens!

So in der Richtung müßte es klappen...

Gruß, Michael

 

Klappt leider nicht :/ kommt Laufzeitfehler

Sub Email_an_ADM_senden()

Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim Sss As String
Dim Sh As Shape
Dim Sht As Worksheet

Application.ScreenUpdating = False


'Kopiert aktuelles Sheet in eine neue Mappe welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel

For Each Sh In ActiveSheet.Shapes
If TypeName(Sh.OLEFormat.Object) = "Button" Then Sh.Delete
Next
' set Sht = ActiveSheet
Set Sht = Worksheets(Sheets(7).TextBox1)
Sht.Copy

ActiveWorkbook.SaveAs Filename:="\\de.root.net\Dfs-data\man-teams\Vkid\Infothek\Neukunden an ADM" & "\" & Sss & ".xls"

With ActiveWorkbook
aws = .FullName
.Close
End With
'InitializeOutlook
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.GetInspector
'Mailadresse An
.to = "ADM HIER EINTRAGEN"
'Hier wird die temporär gespeicherte Datei als Attachment zugefügt
.Subject = Sss
'Hier wird der Betreff eingefügt
.Attachments.Add aws
'Hier wird die Mail nochmals angezeigt
.display
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing

Application.ScreenUpdating = True

Call TextFelderLeeren
'Hier wird das original Formular geleert

End Sub

 

Moinsens!

Jo, glaub ich... ;-)

Die Zeilen mit dem Sht.Copy müssen ein paar höher und sollten das Activesheet.Copy ersetzen. Sonst kopierst Du ja 2 Blätter. Du kannst aber mit dem Kommentar ' wechseln zwischen dem ActiveSheet und dem Sheet laut TextBox. Je nachdem, welche der beiden Zeilen Du auskommentierst.

Außerdem weist Du nirgends der Variable Sss einen Wert zu, obwohl Du sie 2x benutzt (beim Filenamen und bei Subject). Da hast Du wohl die Zeile mit dem "Sss = ..." vergessen...

Gruß, Michael

 

Hi,

ich bekomme es einfach nicht hin :-( Bitte helft mir.

Sub Email_an_ADM_senden()

Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim Sss As String
Dim Sh As Shape
Dim Sht As Worksheet

Application.ScreenUpdating = False


'Kopiert aktuelles Sheet in eine neue Mappe welche nur diese Tabelle enthält
' set Sht = ActiveSheet
Set Sht = Worksheets(Sheets(7).TextBox1)
Sht.Copy

'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel

For Each Sh In ActiveSheet.Shapes
If TypeName(Sh.OLEFormat.Object) = "Button" Then Sh.Delete
Next
' set Sht = ActiveSheet
Set Sht = Worksheets(Sheets(7).TextBox1)

Sss = "Neukunde " & Sheets(7).TextBox1 & " " & "aus" & " " & Sheets(7).TextBox4 & " " & "aufgenommen am " & Date & " um " & Time & " Uhr"
ActiveWorkbook.SaveAs Filename:="\\de.root.net\Dfs-data\man-teams\Vkid\Infothek\Neukunden an ADM" & "\" & Sss & ".xls"

With ActiveWorkbook
aws = .FullName
.Close
End With
'InitializeOutlook
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.GetInspector
'Mailadresse An
.to = "ADM HIER EINTRAGEN"
'Hier wird die temporär gespeicherte Datei als Attachment zugefügt
.Subject = Sss
'Hier wird der Betreff eingefügt
.Attachments.Add aws
'Hier wird die Mail nochmals angezeigt
.display
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing

Application.ScreenUpdating = True

Call TextFelderLeeren
'Hier wird das original Formular geleert

End Sub

Fehler kommt bei:
Set Sht = Worksheets(Sheets(7).TextBox1)

 

Moinsens!

Ah, mein Fehler, glaube ich... Da müßte noch ein ".Value" (oder war's ein ".Text"?) hinter "Textbox1" gehängt werden, damit er nicht das Objekt "TextBox" zurückliefert, sondern den String, der in der Textbox steht.

Zur Überprüfung im VBA-Editor:

Code:

Dim Ss as String
[ ... ]
Ss =Sheets(7).TextBox1.Value
Set Sht = Worksheets(Ss)

Kommt es zu keinem Fehler mehr beim "set", dann ist ja alles in Ordnung. Wenn doch, laß Dir dann mal die Variable "Ss" anzeigen, welchen Wert die hat. Das sollte ja eigentlich der Blattname sein.

Weiter oben: 2x das "set ..." ist nicht notwendig. Ist die Variable gesetzt, behält die den Wert bis Prozedur-Ende. Die beiden Zeilen hinter dem "next" könnten also besser raus...

Gruß, Michael

 

Funktioniert bei excel 2010 aber nicht 2003

Option Explicit

Sub Email_an_ADM_senden()

Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim aws As String
Dim Sh As Shape

Application.ScreenUpdating = False


'Kopiert aktuelles Sheet in eine neue Mappe welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel

For Each Sh In ActiveSheet.Shapes
If TypeName(Sh.OLEFormat.Object) = "Button" Then Sh.Delete
Next

ActiveWorkbook.SaveAs Filename:="\\de.root.net\Dfs-data\man-teams\Vkid\Infothek\Neukunden an ADM" & "\" & Format(Now, "dd.mm.yyyy_hhmm ") & ActiveSheet.TextBox1 & ".xls" :::::: hier entsteht der 438 fehler bei excel 2003


With ActiveWorkbook
aws = .FullName
.Close
End With
'InitializeOutlook
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.GetInspector
'Mailadresse An
.to = "ADM HIER EINTRAGEN"
'Hier wird die temporär gespeicherte Datei als Attachment zugefügt
.Subject = "Neukunde " & Sheets(7).TextBox1 & " " & "aus" & " " & Sheets(7).TextBox4 & " " & "aufgenommen am " & Date & " um " & Time & " Uhr"
'Hier wird der Betreff eingefügt
.Attachments.Add aws
'Hier wird die Mail nochmals angezeigt
.display
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing

Application.ScreenUpdating = True

Call TextFelderLeeren
'Hier wird das original Formular geleert

End Sub
Sub TextFelderLeeren()
Dim tbx As OLEObject
For Each tbx In ActiveSheet.OLEObjects
If TypeName(tbx.Object) = "TextBox" Then
tbx.Object.Text = ""
End If
Next
End Sub



Ich habe es hinbekommen. Aber bei EXEL 2003 schreit er wegen Laufzeitfehler 438.
Kann das jemand umschreiben?!

 

Moinsens!

Ähm... Ach ja? Und wo unterscheidet sich der Source jetzt von dem im 1. Posting, wo es noch nicht funktionierte? Ich mein, speziell: Wo wird jetzt die Textbox ausgewertet, statt das aktuelle Worksheet zu kopieren?

Da wäre jetzt hilfreich zu wissen, was genau dieser Fehler sagt und in welcher Zeile er auftritt. Aber wenn ein Objekt eine Eigenschaft nicht besitzt bzw. eine Methode nicht unterstützt, dann ist die wohl erst in der neueren Version dazu gekommen. Die gibt es dann in der älteren Version einfach noch nicht. Und ob man es durch "workarounds" hinbekommt ist vom Einzelfall abhängig.

Ja, klar:

...aber ob das jetzt besser ist? ;-)

Gruß, Michael