VBA: Sheets benennen

03/02/2009 - 14:45 von Beck, Alwin | Report spam
Konfig : Excel 2003

Hallo,
ich muss folg. Problem über Excel VBA lösen und automatisieren :

Eine Maschine legt nach jedem Produktionsvorgang (also mehrfach am
Tag) für
diesen Produktionsvorgang eine CSV-Datei in einem Pfad ab. Der
Dateiname
ist immer unterschiedlich und sieht wie folgt aus (Beispiel) :
shift_20090203112641.csv

Der Anwender muss nun diese Daten analysieren und liest somit auch
jeden Tag einzeln die Làufe
ein - muss dafür immer den Import machen usw.

Nun soll dieses auf "Knopfdruck" passieren. D.h. der User gibt nur
noch den Dateinamen in die Inputbox
ein und der Import soll automatisch erfolgen.

Bis hierher funtkioniert es auch auf einfache Art und weise und soll
aber folg. Anforderung integriert werden :

- der Import soll in ein neues Tabellenblatt erfolgen welches dann den
Namen der Datei erhàlt
(sprich neues Sheet anlegen und dieses gem. meiner Variable Datei
benennen)
- nach dem Import soll die Datei im Pfad umbenannt werden, so dass
ersichtlich ist, welche bereits importiert wurden.
(sprich Datei gem. meiner Variable Datei im Pfad gem. Variable Pfad
umbenennen)

Wie kann ich dieses 2 Punkte in meinen VBA integrieren ?


Private Sub CommandButton1_Click()
'
' IMPORT Maschinendatein aus CSV
'
Dim Pfad
Dim Datei
Dim Pfadgesamt
Pfad = "\\0-240-06-8084\cadpool\Mde\"

Datei = InputBox("Dateiname eintragen")

Pfadgesamt = Pfad & Datei

'Sheets.Add


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Pfadgesamt, Destination:= _
Range("A1"))
.Name = Datei
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub

Danke
Gruß
Albe
 

Lesen sie die antworten

#1 Andreas Killer
03/02/2009 - 15:28 | Warnen spam
Beck, Alwin schrieb:

Eine Maschine legt nach jedem Produktionsvorgang (also mehrfach am Tag) für
diesen Produktionsvorgang eine CSV-Datei in einem Pfad ab. Der Dateiname
ist immer unterschiedlich und sieht wie folgt aus (Beispiel) :
shift_20090203112641.csv

Der Anwender muss nun diese Daten analysieren und liest somit auch jeden
Tag einzeln die Làufe
ein - muss dafür immer den Import machen usw.

Nun soll dieses auf "Knopfdruck" passieren. D.h. der User gibt nur noch
den Dateinamen in die Inputbox
ein und der Import soll automatisch erfolgen.


Ich hab das nicht getestet, sollte aber funktionieren:

Private Sub CommandButton1_Click()
' IMPORT Maschinendatein aus CSV
Dim Pfad As String, Datei As Variant, PfadGesamt As String
Dim S As Worksheet, Found As Boolean, Antwort As Integer

Pfad = "\\0-240-06-8084\cadpool\Mde\"

Datei = InputBox("Dateiname eintragen")
'Hat der User abgebrochen?
If Datei = "" Then Exit Sub

'Anmerkung: Statt Inputbox könnte man auch mit GetOpenFileName
'die Datei auswàhlen lassen:

'Datei = Application _
.GetOpenFilename("Produktionsvorgang (*.csv), *.csv")
''Hat der User abgebrochen?
'If Datei = False Then Exit Sub

PfadGesamt = Pfad & Datei

'Prüfen ob es ein sollches Sheet schon gibt
Found = False
For Each S In Sheets
If S.Name = Datei Then
Found = True
Exit For
End If
Next

If Found Then
'Fehler ausgeben, ggf. Sheet löschen
Antwort = MsgBox("Tabellenblatt " & Datei & _
" existiert bereits. Löschen oder Abbruch?", _
vbOKCancel + vbCritical)
Select Case Antwort
Case vbOK
'Fehlermeldungen temp. aus, Sheet löschen
Application.DisplayAlerts = False
Sheets(Datei).Delete
Application.DisplayAlerts = True
Case vbCancel
'Abbruch
Exit Sub
End Select
End If

'Sheet hinzufügen
Set S = Sheets.Add
'Umbenennen
S.Name = Datei

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & PfadGesamt, Destination:= _
Range("A1"))
.Name = Datei
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub


Andreas.

Ähnliche fragen