2.4k Aufrufe
Gefragt in Skripte(PHP,ASP,Perl...) von
Hallo,

ich suche ein paar Anregungen zur Syntax.
Ich möchte aus einer gegebenen Excel-Tabelle alle Zeilen auslesen, um sie dann weiter verarbeiten zu können.
Bin ein Neuling auf dem Gebiet VB Script und suche eher ne allgemeine Syntax und auch das Ausgabeformat, wenn ich das ganze testen möchte.

MfG

3 Antworten

0 Punkte
Beantwortet von kicia Mitglied (939 Punkte)
das beispiel ist zwar js, aber der umgang mit excel wäre der selbe:
www.supportnet.de/faqsthread/2243647

vbs dokumentation findest Du bei
microsoft
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi charlie brown ^^

dann ein paar beispiele zum experimentieren :-))

gruss nighty

liesst die dateien von einem angegebenen pfad mit unterordnern

mit den 2 angegebenen endungen JPG + TIF

Private strList() As String
Private ordlist() As String
Private lngCount As Long
Option Explicit

Public Sub Einlesen()
Dim Index As Integer
Dim Eingabe As String
Dim Schalter As Boolean
lngCount = 0
SearchFiles "C:\Temp", "*.*"
If lngCount = 0 Then
MsgBox "No file found"
Exit Sub
End If
For Index = 0 To UBound(strList)
If InStr(strList(Index), "TIF") > 0 Or InStr(strList(Index), "JPG") > 0 Then
Schalter = True
'DeinCode bei fund
End If
Next Index
If Schalter = False Then MsgBox ("Keine Datei gefunden")
End Sub

Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(lngCount)
ReDim Preserve ordlist(lngCount)
strList(lngCount) = objFile.Name
ordlist(lngCount) = strFolder
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next
End Sub


naechste beispiel ^^

liesst einen angegebenen bereich(A3 bis E + Zeilenende) aus jeder gefundenen exceldatei von einem angegeben verzeichnis und kopiert diesen ab der ersten gefundenen freien zeile zum workbook tabelle1

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("A3:E" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi charlie brown ^^

noch ein beispiel das dateien in diesem format liesst

xxxxxx1
xxx2
xxxxxx3
bis 100

interessant ist hier auch die fehlerbehandlung

gruss nighty

Sub DateienLesen()
On Error GoTo fehlerbehandlung
Call EventsOff
Dim DateiName As String
Dim zaehler As Integer
Dim Ansage As String
DateiName = Dir("C:\Temp\" & "*.xls")
For zaehler = 1 To 100
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & Mid(DateiName, 1, Len(DateiName) - CStr(Len(zaehler)) & CStr(zaehler))
Rem hier waere dann dein code zur weiteren verarbeitung bzw aufruf eines makros ,wie z.b. Call MeinMakro
Workbooks(DateiName).Save
Workbooks(DateiName).Close
End If
DateiName = Dir
Next zaehler
Call EventsOn
End
fehlerbehandlung:
If Err = 5 Then
Ansage = MsgBox("Die Datei " & "*" & CStr(zaehler) & ".xls ist nicht vorhanden,weiter ?", vbYesNo)
If Ansage = vbYes Then
Resume Next
Else
Call EventsOn
End
End If
Else
Err.Raise 5
End If
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
...