AW: Dateiname nur mit Teilstring ansprechen?
12.06.2005 18:43:46
Korl
Hallo Steffan,
auch Dir erstmal ein Dankeschön für Deine Unterstützung.
Vielleicht stelle ich mal meinen komplette Code da:
Hiermit wird die Taxtdatei geöffnet und an Userform übergeben:
Sub testtextaufruf()
Dim x As String
ChDir "C:\Test"
x = Application _
.GetOpenFilename("Text Dateien (*.txt), *.txt")
Workbooks.OpenText Filename:=x, Origin:=xlMSDOS, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
UserForm1.Show
End Sub
Diese habe ich im nachfolgenden Code "WksG" benannt:
Private Sub CommandButton2_Click()
' OK-Button
Dim WksD As Worksheet
Dim WksG As Workbook
Dim WksK As Worksheet
Dim lLetzteD As Long
Dim lLetzteG As Long
Dim Wert$
Dim WertZ As Long
'Dim StrDatei As String
' StrDatei = "GEBSTAT"
On Error GoTo zu
Set WksG = Workbooks
Set WksD = Workbooks("GebStat Test").Worksheets("DB")
Set WksK = Workbooks("GebStat Test").Worksheets("Kehrbezirke")
If ComboBox1.Value = "" Then
MsgBox ("Es muß schon eine Kehrbezirksnummer ausgesucht werden,") & vbLf & " " _
& vbLf & "die dann übernommen werden soll !"
Exit Sub
Else
WksG.Range("E1:E" & Range("A65536").End(xlUp).Row).Value = ComboBox1.Value
' Eintrag der Kehrbezirks-Nr.
Wert = ComboBox1.Value
rnge = Wert
WksG.Range("E1:E" & Range("A65536").End(xlUp).Row).Value = Wert
If WorksheetFunction.CountIf(WksD.Range("E1:E65536"), WksG.Range("E1").Value) > 0 Then
UserForm1.Hide
WksG.Activate
WksG.Close savechanges:=False
MsgBox "Der Kehrbezirk ist schon aufgenommen, darum Abruch!"
Exit Sub
Else
' Eintrag der Daten ins Sheet "DB"
lLetzteG = IIf(WksG.Range("A65536") <> "", 65536, WksG.Range("C65536").End(xlUp).Row)
lLetzteD = IIf(WksD.Range("A65536") <> "", 65536, WksD.Range("A65536").End(xlUp).Row)
WksG.Range("A1:E" & lLetzteG).Copy
WksD.Range("A" & lLetzteD + 1).PasteSpecial Paste:=xlValues
' ermittelt den letzten Wert aus "DB" und meldet den Vollzug
z = WksD.Cells(65536, 4).End(xlUp).Row ' letzter Wert in Spalte D
WertZ = Cells(z, 4)
Set d = WksK.Columns(3).Find(What:=Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not d Is Nothing Then d(1, 2) = "OK"
Application.CutCopyMode = False 'entfernt die Zwischenspeicherung
' die Datei GEBSTAT wird wieder geschlossen
WksG.Activate
WksG.Close savechanges:=False
' die Datenbank wird redimensioniert
ActiveWorkbook.Names.Add Name:="DB", RefersToR1C1:=Sheets("DB").Range("A1").CurrentRegion
ende:
'aktualisiert die Pivottabel
Worksheets("Zusammenfassung").PivotTables("PivotTable1").PivotCache.Refresh
Worksheets("Kehrbezirke").Select
Range("G5").Select
End If
End If
Unload Me
zu:
End Sub
Könnt Ihr etwas mit meinem zusammengebastelten Code anfangen?
Gruß Korl