Compare date property in an array

Nur wenn Du die Daten in ein Array einliest, dieses sortierst und wieder zurückschreibst.

Andreas.

Am 09.01.2011 22:49, schrieb ddfgdf:

Leider gibt es bei Application.FileSearch eine Fehlermeldung. Woran kann das liegen?

Das wurde mit 2007 netterweise abgeschafft. Aber es gibt ja Ersatzlösungen. .-)

Der Code muss in ein Klassenmodul, wie's geht steht hier:

http://www.online-excel.de/excel/singsel_vba.php?f=44#s6

Wenn Du den Code eingefügt hast drückst Du F4 und benennst es von "Klasse1" in "FileSearch" um.

Dann erstellst Du eine globale Variable:

Dim ApplicationFileSearch As New FileSearch

Und änderst die WITH-Anweisung in Deinem Makro:

With ApplicationFileSearch

Das Rest geht wie gewohnt.

Andreas.

'Version 1.21

'

'12.10.09

'Attribute VB_Name = "FileSearch"

'Nachbildung des FileSearch-Objektes für Office 2007

'Property-Tests sind nicht implementiert!

Option Explicit

Option Compare Text

Public Enum msoSortBy

msoSortByFileName = 1

msoSortBySize = 2

msoSortByFileType = 3

msoSortByLastModified = 4

End Enum

Public Enum msoFileType

msoFileTypeAllFiles = 1

msoFileTypeOfficeFiles = 2

msoFileTypeWordDocuments = 3

msoFileTypeExcelWorkbooks = 4

msoFileTypePowerPointPresentations = 5

msoFileTypeBinders = 6

msoFileTypeDatabases = 7

msoFileTypeTemplates = 8

End Enum

Public Enum msoLastModified

msoLastModifiedYesterday = 1

msoLastModifiedToday = 2

msoLastModifiedLastWeek = 3

msoLastModifiedThisWeek = 4

msoLastModifiedLastMonth = 5

msoLastModifiedThisMonth = 6

msoLastModifiedAnyTime = 7

End Enum

Private fsFileName As Variant

Public LookIn As String

Public SearchSubFolders As Boolean

Public FoundFiles As Collection

Private fsFileType As msoFileType

Private fsLastModified As msoLastModified

Private SortFiles As Collection

Private SortFilesBy As msoSortBy

Private fs As Object 'FileSystemObject

Private Const INVALID_HANDLE_VALUE = -1

Private Const MAX_PATH = 260

Private Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Private Type WIN32_FIND_DATA

dwFileAttributes As Long

ftCreationTime As FILETIME

ftLastAccessTime As FILETIME

ftLastWriteTime As FILETIME

nFileSizeHigh As Long

nFileSizeLow As Long

dwReserved0 As Long

dwReserved1 As Long

cFileName As String * MAX_PATH

cAlternate As String * 14

End Type

Private Const FIND_FIRST_EX_CASE_SENSITIVE As Long = 1

Private Const FIND_FIRST_EX_LARGE_FETCH As Long = 2

Private Enum FINDEX_SEARCH_OPS

FindExSearchNameMatch

FindExSearchLimitToDirectories

FindExSearchLimitToDevices

End Enum

Private Enum FINDEX_INFO_LEVELS

FindExInfoStandard

FindExInfoMaxInfoLevel

End Enum

Private Declare Function FindFirstFile Lib "kernel32" Alias _

"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _

As WIN32_FIND_DATA) As Long

Private Declare Function FindFirstFileEx Lib "kernel32" Alias _

"FindFirstFileExA" (ByVal lpFileName As String, ByVal _

fInfoLevelId As Long, lpFindFileData As WIN32_FIND_DATA, _

ByVal fSearchOp As Long, ByVal lpSearchFilter As Long, ByVal _

dwAdditionalFlags As Long) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias _

"FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As _

WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal _

hFindFile As Long) As Long

Private Declare Function lstrlenA Lib "kernel32" (ByVal _

psString As Any) As Long

Private Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Private Declare Function FileTimeToSystemTime Lib "kernel32" ( _

lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias _

"RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount _

As Long)

Private Sub Class_Initialize()

Set FoundFiles = New Collection

Set SortFiles = New Collection

Set fs = CreateObject("Scripting.FileSystemObject")

FileType = msoFileTypeOfficeFiles

LastModified = msoLastModifiedAnyTime

End Sub

Private Sub Class_Terminate()

Set FoundFiles = Nothing

Set SortFiles = Nothing

Set fs = Nothing

End Sub

Public Sub NewSearch()

Filename = ""

LookIn = ""

FileType = msoFileTypeOfficeFiles

LastModified = msoLastModifiedAnyTime

SearchSubFolders = False

ClearCollections

End Sub

Private Sub ClearCollections()

Dim I As Long

With SortFiles

For I = .Count To 1 Step -1

.Remove I

Next

End With

With FoundFiles

For I = .Count To 1 Step -1

.Remove I

Next

End With

End Sub

Property Let Filename(Value As Variant)

If IsArray(Value) Then

fsFileName = Value

Else

fsFileName = Array(Value)

End If

fsFileType = 0

End Property

Property Get Filename() As Variant

Filename = Join(fsFileName, ", ")

End Property

Property Let FileType(Value As msoFileType)

fsFileType = Value

Select Case Value

Case msoFileTypeAllFiles

fsFileName = Array("*.*")

Case msoFileTypeOfficeFiles

fsFileName = Array("*.doc", "*.dot", "*.htm", "*.html", _

"*.mdb", "*.mpd", "*.obd", "*.obt", "*.pot", "*.pps", "*.ppt", _

"*.xls", "*.xlt")

Case msoFileTypeWordDocuments

fsFileName = Array("*.doc", "*.htm", "*.html")

Case msoFileTypeExcelWorkbooks

fsFileName = Array("*.xls")

Case msoFileTypePowerPointPresentations

fsFileName = Array("*.pps", "*.ppt")

Case msoFileTypeBinders

fsFileName = Array("*.obd")

Case msoFileTypeDatabases

fsFileName = Array("*.mdb", "*.mpd")

Case msoFileTypeTemplates

fsFileName = Array("*.dot", "*.obt", "*.pot", "*.xlt")

Case Else

fsFileType = 0

fsFileName = Array("*.*")

End Select

End Property

Property Get FileType() As msoFileType

FileType = fsFileType

End Property

Property Let LastModified(Value As msoLastModified)

If Value >= 1 And Value <= 7 Then

fsLastModified = Value

Else

fsLastModified = msoLastModifiedAnyTime

End If

End Property

Property Get LastModified() As msoLastModified

LastModified = fsLastModified

End Property

Private Function MakeDecimal(ByVal Lo As Long, ByVal Hi As _

Long, Optional ByVal wEx As Long = 0, Optional Minus As _

Boolean = False) As Variant

If Minus Then MakeDecimal = CDec(-1) Else MakeDecimal = CDec(1)

CopyMemory ByVal VarPtr(MakeDecimal) + 8, Lo, 4

CopyMemory ByVal VarPtr(MakeDecimal) + 12, Hi, 4

If wEx <> 0 Then CopyMemory ByVal VarPtr(MakeDecimal) + 4, _

Lo, 4

End Function

Private Function FirstWeek(ByVal Datum As Date) As Date

'Liefert den 1. Tag der Woche in dem Datum liegt

FirstWeek = Datum - Weekday(Datum, vbUseSystemDayOfWeek) + 1

End Function

Private Sub SearchPrim(ByVal Path As String)

Dim hFindFile As Long, hFoundFile As WIN32_FIND_DATA

Dim FName As String, STime As SYSTEMTIME, FTime As Date, _

ETime As Date, LTime As Date

Dim I As Integer, AddIt As Boolean

If fsLastModified <> msoLastModifiedAnyTime Then

Select Case fsLastModified

Case msoLastModifiedYesterday

ETime = Date - 1

LTime = Date - 1

Case msoLastModifiedToday

ETime = Date

LTime = Date

Case msoLastModifiedLastWeek

ETime = FirstWeek(Date) - 7

LTime = ETime + 6

Case msoLastModifiedThisWeek

ETime = FirstWeek(Date)

LTime = ETime + 6

Case msoLastModifiedLastMonth

ETime = DateSerial(Year(Date), Month(Date) - 1, 1)

LTime = DateSerial(Year(Date), Month(Date), 0)

Case msoLastModifiedThisMonth

ETime = DateSerial(Year(Date), Month(Date), 1)

LTime = DateSerial(Year(Date), Month(Date) + 1, 0)

End Select

End If

'Sicherstelen das ein Backslash dran ist

If Right(Path, 1) <> "\" Then Path = Path & "\"

'Suche nach den Dateien

For I = LBound(fsFileName) To UBound(fsFileName)

'hFindFile = FindFirstFile(Path & fsFileName(I) & Chr(0), _

hFoundFile)

hFindFile = FindFirstFileEx(Path & fsFileName(I) & Chr(0), _

FindExInfoStandard&, hFoundFile, FindExSearchNameMatch&, 0&, 0&)

If hFindFile <> INVALID_HANDLE_VALUE Then

Do

With hFoundFile

'Die Verzeichnisse ausschließen

If Not (.dwFileAttributes And vbDirectory) = _

vbDirectory Then

If fsLastModified = msoLastModifiedAnyTime Then

AddIt = True

Else

'Konvertiere Dateizeit zu Systemzeit

FileTimeToSystemTime .ftLastWriteTime, STime

'Generiere VBA-Datum

With STime

FTime = DateSerial(.wYear, .wMonth, .wDay)

End With

AddIt = FTime >= ETime And FTime <= LTime

End If

If AddIt Then

FName = Mid$(.cFileName, 1, lstrlenA(.cFileName))

'Problem *.htm findet auch *.html

AddIt = FName Like fsFileName(I)

End If

If AddIt Then

FoundFiles.Add Path & FName

'Sollen wir sortieren?

Select Case SortFilesBy

Case msoSortByFileName

'Pfad, dann Name

SortFiles.Add FName & Path

Case msoSortByFileType

'Extension, dann Pfad, dann Name

SortFiles.Add fs.GetExtensionName(FName) & _

Path & FName

Case msoSortByLastModified

'Konvertiere Dateizeit zu Systemzeit

FileTimeToSystemTime .ftLastWriteTime, STime

'Generiere VBA-Datum

With STime

FTime = DateSerial(.wYear, .wMonth, .wDay) _

+ TimeSerial(.wHour, .wMinute, .wSecond)

End With

SortFiles.Add FTime

Case msoSortBySize

SortFiles.Add MakeDecimal(.nFileSizeLow, _

.nFileSizeHigh)

End Select

End If

End If

End With

Loop Until FindNextFile(hFindFile, hFoundFile) <> 1

FindClose hFindFile

End If

Next

If SearchSubFolders Then

'Suche nach einem Verzeichnis

'hFindFile = FindFirstFile(Path & "*." & Chr(0), hFoundFile)

'hFindFile = FindFirstFileEx(Path & "*." & Chr(0), _

FindExInfoStandard&, hFoundFile, _

FindExSearchLimitToDirectories&, 0&, FIND_FIRST_EX_LARGE_FETCH)

hFindFile = FindFirstFileEx(Path & "*." & Chr(0), _

FindExInfoStandard&, hFoundFile, _

FindExSearchLimitToDirectories&, 0&, 0&)

If hFindFile <> INVALID_HANDLE_VALUE Then

Do

With hFoundFile

'Die Verzeichnisse "." und ".." ausschließen

If Left$(.cFileName, 1) <> "." And ( _

.dwFileAttributes And vbDirectory) = vbDirectory Then

FName = Mid$(.cFileName, 1, lstrlenA(.cFileName))

'Starte rekursive Suche

SearchPrim Path & FName

End If

End With

Loop Until FindNextFile(hFindFile, hFoundFile) <> 1

FindClose hFindFile

End If

End If

End Sub

Private Sub QuickSortCollection(ByRef Liste As Collection, _

ByRef Data As Collection, Optional Start, Optional Ende, _

Optional Compare As vbCompareMethod = vbDatabaseCompare, _

Optional SortOrder As MsoSortOrder = msoSortOrderAscending)

'Sortiert eine Collection mit beliebigen Werten im Bereich _

Start..Ende, führt die Data-Collection parallel mit

'vbDatabaseCompare sortiert Zahlen, ansonsten werden Texte _

sortiert

Dim I As Long, j As Long, C As Integer, Pivot As Variant

If Liste.Count <= 1 Then Exit Sub

If IsMissing(Start) Then Start = 1

If IsMissing(Ende) Then Ende = Liste.Count

If SortOrder = msoSortOrderAscending Then C = 1 Else C = -1

I = Start: j = Ende

Pivot = Liste((Start + Ende) \ 2)

Do

If Compare = vbDatabaseCompare Then

'Zahlen sortieren

If SortOrder = msoSortOrderAscending Then

While (Liste(I) < Pivot): I = I + 1: Wend

While (Liste(j) > Pivot): j = j - 1: Wend

Else

While (Liste(I) > Pivot): I = I + 1: Wend

While (Liste(j) < Pivot): j = j - 1: Wend

End If

Else

'Texte sortieren

Do While (StrComp(Liste(I), Pivot, Compare) = -C): I = I _

+ 1: Loop

Do While (StrComp(Liste(j), Pivot, Compare) = C): j = j - _

1: Loop

End If

If (I <= j) Then

If I < j Then

Liste.Add Liste(I), After:=j

Liste.Add Liste(j), After:=I

Liste.Remove I

Liste.Remove j

Data.Add Data(I), After:=j

Data.Add Data(j), After:=I

Data.Remove I

Data.Remove j

End If

I = I + 1: j = j - 1

End If

Loop Until (I > j)

If (Start < j) Then QuickSortCollection Liste, Data, Start, _

j, Compare, SortOrder

If (I < Ende) Then QuickSortCollection Liste, Data, I, Ende, _

Compare, SortOrder

End Sub

Public Function Execute(Optional SortBy As msoSortBy = 0, _

Optional SortOrder As MsoSortOrder = msoSortOrderAscending, _

Optional AlwaysAccurate As Boolean = True) As Long

Dim I As Long

'Beginnt die Suche nach den angegebenen Dateien.

'SortBy:

' Die für die Sortierung der zurückgegebenen Dateien _

verwendete Methode. Dies kann eine der folgenden MsoSortBy- _

Konstanten sein: msoSortbyFileName, msoSortbyFileType, _

msoSortbyLastModified oder msoSortbySize. Ist SortBy = 0 wird _

nicht sortiert

'SortOrder:

' Die Reihenfolge, in der die zurückgegebenen Dateien _

sortiert werden sollen. Dies kann eine der folgenden _

MsoSortOrder-Konstanten sein: msoSortOrderAscending oder _

msoSortOrderDescending.

'AlwaysAccurate:

' Ohne Funktion, nur aus Kompatiblitätsgründen

ClearCollections

SortFilesBy = SortBy

SearchPrim LookIn

Execute = FoundFiles.Count

Select Case SortBy

Case msoSortByFileName, msoSortByFileType

QuickSortCollection SortFiles, FoundFiles, Compare:= _

vbTextCompare, SortOrder:=SortOrder

Case msoSortByLastModified, msoSortBySize

QuickSortCollection SortFiles, FoundFiles, Compare:= _

vbDatabaseCompare, SortOrder:=SortOrder

End Select

End Function

Hi Thomas,

ich habe nun die Reparaturinstallation durchgeführt. Nun kommt zwar nicht mehr das Problem mit der setup.exe, aber die Installation bricht mit einem Fehler ab. Die ist nur ein kleiner Teil der Meldung die ich finden konnte. Vielleicht hilft dies:

MSI(INFO): 'Property(S): ARPNOMODIFY = 1'

MSI(INFO): 'Property(S): SetupExeMetadata = PACKAGE.XML_90006E04070000;SETUP.XML_90006E04070000;BRANDING.XML_1031'

MSI(INFO): 'Property(S): ARPSYSTEMCOMPONENT = 1'

MSI(INFO): 'Property(S): StandardExecuteActions_Ref = 0'

MSI(INFO): 'Property(S): SuppressStandardActions_Ref = 0'

MSI(INFO): 'Property(S): InstalledByCatalyst_Ref = 0'

MSI(INFO): 'Property(S): SetARPINSTALLLOCATIONProperty_Ref = 0'

MSI(INFO): 'Property(S): SETUPSUPPORTURL = http://support.microsoft.com/?kbid=xxxxxx'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_PROBLEM_PRE = Falls das Problem weiterhin besteht, wenden Sie sich an den Microsoft-Produktsupport. Informationen zur Kontaktaufnahme mit dem Produktsupport finden Sie hier: '

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_PROBLEM_POST = .'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_PERMISSION_PRE = Stellen Sie sicher, dass Sie über ausreichende Berechtigungen zum Zugreifen auf die Registrierung verfügen, oder wenden Sie sich an den Microsoft-Produktsupport. Informationen zur Kontaktaufnahme
mit dem Produktsupport finden Sie hier: '

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_PERMISSION_POST = .'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_PRE = Wenden Sie sich an den Microsoft-Produktsupport. Informationen zur Kontaktaufnahme mit dem Produktsupport finden Sie hier: '

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_RETAIL_DEFAULT_POST = .'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_OEM_DEFAULT = Contact your computer manufacturer's product support for assistance.'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_OEM_DEFAULT_PERMISSION = Verify that you have sufficient permissions to access the registry or contact your computer manufacturer's product support for assistance.'

MSI(INFO): 'Property(S): ERRORSUPPORTTEXT_OEM_DEFAULT_PROBLEM = If problem persists, contact your computer manufacturer's product support for assistance.'

MSI(INFO): 'Property(S): OfficeMUICommonFeatureGroup_Shared_1031_Ref = 0'

MSI(INFO): 'Property(S): VSAssemblyVersion80.5326715A_77CF_482B_8CA0_13476898242B = 8.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion90.5326715A_77CF_482B_8CA0_13476898242B = 9.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion100.5326715A_77CF_482B_8CA0_13476898242B = 10.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion.5326715A_77CF_482B_8CA0_13476898242B = 10.0.0.0'

MSI(INFO): 'Property(S): ARPURLUpdateInfo.5326715A_77CF_482B_8CA0_13476898242B = http://go.microsoft.com/fwlink/?LinkId=133408'

MSI(INFO): 'Property(S): comspec_cmd.5326715A_77CF_482B_8CA0_13476898242B = %comspec%'

MSI(INFO): 'Property(S): DDPatch.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): FeatureID.5326715A_77CF_482B_8CA0_13476898242B = 1'

MSI(INFO): 'Property(S): MSDE_MSMS_NOREINSTALL.5326715A_77CF_482B_8CA0_13476898242B = True'

MSI(INFO): 'Property(S): NullGUID.5326715A_77CF_482B_8CA0_13476898242B = {00000000-0000-0000-0000-000000000000}'

MSI(INFO): 'Property(S): PIDRegEntryName.5326715A_77CF_482B_8CA0_13476898242B = ProductID'

MSI(INFO): 'Property(S): PIDUserNameRegKey.5326715A_77CF_482B_8CA0_13476898242B = SOFTWARE\Microsoft\VisualStudio\7.0\Registration'

MSI(INFO): 'Property(S): PIDUserNameRegRoot.5326715A_77CF_482B_8CA0_13476898242B = HKEY_LOCAL_MACHINE'

MSI(INFO): 'Property(S): PrimaryDir.5326715A_77CF_482B_8CA0_13476898242B = VS7.3643236F_FC70_11D3_A536_0090278A1BB8'

MSI(INFO): 'Property(S): REPAIR_REINSTALLMODE.5326715A_77CF_482B_8CA0_13476898242B = pecmsu'

MSI(INFO): 'Property(S): ReserveAdditionalCostVS7UI.5326715A_77CF_482B_8CA0_13476898242B = 8388608'

MSI(INFO): 'Property(S): RunCount.5326715A_77CF_482B_8CA0_13476898242B = 49'

MSI(INFO): 'Property(S): UpdateProp1.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): UpdateProp2.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): UpdateProp3.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): UpdateProp4.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): UpdateProp5.5326715A_77CF_482B_8CA0_13476898242B = 0'

MSI(INFO): 'Property(S): UserNameRegEntryName.5326715A_77CF_482B_8CA0_13476898242B = UserName'

MSI(INFO): 'Property(S): VBS_WWWROOT.5326715A_77CF_482B_8CA0_13476898242B = Property("CommonWWWRoot.3643236F_FC70_11D3_A536_0090278A1BB8") = left(Property("WWWROOTREGKEY.3643236F_FC70_11D3_A536_0090278A1BB8"),instr(Property("WWWROOTREGKEY.3643236F_FC70_11D3_A536_0090278A1BB8"),",")-1)'

MSI(INFO): 'Property(S): VS7PkgsRoot.5326715A_77CF_482B_8CA0_13476898242B = HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\7.0\Packages\'

MSI(INFO): 'Property(S): VS7RegRoot.5326715A_77CF_482B_8CA0_13476898242B = HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\7.0\'

MSI(INFO): 'Property(S): FXAssemblyVersion.5326715A_77CF_482B_8CA0_13476898242B = 4.0.0.0'

MSI(INFO): 'Property(S): FXAssemblyVersion35.5326715A_77CF_482B_8CA0_13476898242B = 3.5.0.0'

MSI(INFO): 'Property(S): VSDVDDiskPrompt.5326715A_77CF_482B_8CA0_13476898242B = Visual Studio 2010 DVD'

MSI(INFO): 'Property(S): BuildType.5326715A_77CF_482B_8CA0_13476898242B = ret'

MSI(INFO): 'Property(S): URTVersion.5326715A_77CF_482B_8CA0_13476898242B = v4.0.21022'

MSI(INFO): 'Property(S): ProductCPU.5326715A_77CF_482B_8CA0_13476898242B = x86'

MSI(INFO): 'Property(S): ProductEdition.5326715A_77CF_482B_8CA0_13476898242B = RED'

MSI(INFO): 'Property(S): ProductFamily.5326715A_77CF_482B_8CA0_13476898242B = TRIN'

MSI(INFO): 'Property(S): ProductImage.5326715A_77CF_482B_8CA0_13476898242B = net'

MSI(INFO): 'Property(S): RTM_ProductVersion.5326715A_77CF_482B_8CA0_13476898242B = 10.0.21022'

MSI(INFO): 'Property(S): ProductVersionHigh.5326715A_77CF_482B_8CA0_13476898242B = 655360'

MSI(INFO): 'Property(S): ProductVersionLow.5326715A_77CF_482B_8CA0_13476898242B = 1377697793'

MSI(INFO): 'Property(S): DirectoryTable_x86.5326715A_77CF_482B_8CA0_13476898242B = DirectoryTable'

MSI(INFO): 'Property(S): VSAssemblyVersion80.363843CE_60C8_4066_8093_68BA5A039B17 = 8.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion90.363843CE_60C8_4066_8093_68BA5A039B17 = 9.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion100.363843CE_60C8_4066_8093_68BA5A039B17 = 10.0.0.0'

MSI(INFO): 'Property(S): VSAssemblyVersion.363843CE_60C8_4066_8093_68BA5A039B17 = 10.0.0.0'

MSI(INFO): 'Property(S): ARPURLUpdateInfo.363843CE_60C8_4066_8093_68BA5A039B17 = http://go.microsoft.com/fwlink/?LinkId=133408'

MSI(INFO): 'Property(S): comspec_cmd.363843CE_60C8_4066_8093_68BA5A039B17 = %comspec%'

MSI(INFO): 'Property(S): DDPatch.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): DiskNo1.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 1]'

MSI(INFO): 'Property(S): DiskNo10.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 10]'

MSI(INFO): 'Property(S): DiskNo2.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 2]'

MSI(INFO): 'Property(S): DiskNo3.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 3]'

MSI(INFO): 'Property(S): DiskNo4.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 4]'

MSI(INFO): 'Property(S): DiskNo5.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 5]'

MSI(INFO): 'Property(S): DiskNo6.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 6]'

MSI(INFO): 'Property(S): DiskNo7.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 7]'

MSI(INFO): 'Property(S): DiskNo8.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 8]'

MSI(INFO): 'Property(S): DiskNo9.363843CE_60C8_4066_8093_68BA5A039B17 = [Disk 9]'

MSI(INFO): 'Property(S): FeatureID.363843CE_60C8_4066_8093_68BA5A039B17 = 1'

MSI(INFO): 'Property(S): FILESINUSETEXT.363843CE_60C8_4066_8093_68BA5A039B17 = The following applications should be closed before continuing the install:'

MSI(INFO): 'Property(S): MSDE_MSMS_NOREINSTALL.363843CE_60C8_4066_8093_68BA5A039B17 = True'

MSI(INFO): 'Property(S): NullGUID.363843CE_60C8_4066_8093_68BA5A039B17 = {00000000-0000-0000-0000-000000000000}'

MSI(INFO): 'Property(S): PIDRegEntryName.363843CE_60C8_4066_8093_68BA5A039B17 = ProductID'

MSI(INFO): 'Property(S): PIDUserNameRegKey.363843CE_60C8_4066_8093_68BA5A039B17 = SOFTWARE\Microsoft\VisualStudio\7.0\Registration'

MSI(INFO): 'Property(S): PIDUserNameRegRoot.363843CE_60C8_4066_8093_68BA5A039B17 = HKEY_LOCAL_MACHINE'

MSI(INFO): 'Property(S): PrimaryDir.363843CE_60C8_4066_8093_68BA5A039B17 = VS7.3643236F_FC70_11D3_A536_0090278A1BB8'

MSI(INFO): 'Property(S): REPAIR_REINSTALLMODE.363843CE_60C8_4066_8093_68BA5A039B17 = pecmsu'

MSI(INFO): 'Property(S): ReserveAdditionalCostVS7UI.363843CE_60C8_4066_8093_68BA5A039B17 = 8388608'

MSI(INFO): 'Property(S): RunCount.363843CE_60C8_4066_8093_68BA5A039B17 = 49'

MSI(INFO): 'Property(S): ThicketsAUTOTextString.363843CE_60C8_4066_8093_68BA5A039B17 = Show and manage the pair as a single file'

MSI(INFO): 'Property(S): ThicketsNOHIDETextString.363843CE_60C8_4066_8093_68BA5A039B17 = Show both parts but manage as a single file'

MSI(INFO): 'Property(S): ThicketsNONETextString.363843CE_60C8_4066_8093_68BA5A039B17 = Show both parts and manage them individually'

MSI(INFO): 'Property(S): ThicketsTextString.363843CE_60C8_4066_8093_68BA5A039B17 = Managing pairs of Web pages and folders'

MSI(INFO): 'Property(S): UpdateProp1.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): UpdateProp2.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): UpdateProp3.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): UpdateProp4.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): UpdateProp5.363843CE_60C8_4066_8093_68BA5A039B17 = 0'

MSI(INFO): 'Property(S): UserNameRegEntryName.363843CE_60C8_4066_8093_68BA5A039B17 = UserName'

MSI(INFO): 'Property(S): VBS_WWWROOT.363843CE_60C8_4066_8093_68BA5A039B17 = Property("CommonWWWRoot.3643236F_FC70_11D3_A536_0090278A1BB8") = left(Property("WWWROOTREGKEY.3643236F_FC70_11D3_A536_0090278A1BB8"),instr(Property("WWWROOTREGKEY.3643236F_FC70_11D3_A536_0090278A1BB8"),",")-1)'

MSI(INFO): 'Property(S): VS7PkgsRoot.363843CE_60C8_4066_8093_68BA5A039B17 = HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\7.0\Packages\'

MSI(INFO): 'Property(S): VS7RegRoot.363843CE_60C8_4066_8093_68BA5A039B17 = HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\7.0\'

MSI(INFO): 'Property(S): FXAssemblyVersion.363843CE_60C8_4066_8093_68BA5A039B17 = 4.0.0.0'

MSI(INFO): 'Property(S): FXAssemblyVersion35.363843CE_60C8_4066_8093_68BA5A039B17 = 3.5.0.0'

MSI(INFO): 'Property(S): VSDVDDiskPrompt.363843CE_60C8_4066_8093_68BA5A039B17 = Visual Studio 2010 DVD'

MSI(INFO): 'Property(S): BuildType.363843CE_60C8_4066_8093_68BA5A039B17 = ret'

MSI(INFO): 'Property(S): URTVersion.363843CE_60C8_4066_8093_68BA5A039B17 = v4.0.21022'

MSI(INFO): 'Property(S): ProductCPU.363843CE_60C8_4066_8093_68BA5A039B17 = x86'

MSI(INFO): 'Property(S): ProductEdition.363843CE_60C8_4066_8093_68BA5A039B17 = RED'

MSI(INFO): 'Property(S): ProductFamily.363843CE_60C8_4066_8093_68BA5A039B17 = TRIN'

MSI(INFO): 'Property(S): ProductImage.363843CE_60C8_4066_8093_68BA5A039B17 = net'

MSI(INFO): 'Property(S): RTM_ProductVersion.363843CE_60C8_4066_8093_68BA5A039B17 = 10.0.21022'

MSI(INFO): 'Property(S): ProductVersionHigh.363843CE_60C8_4066_8093_68BA5A039B17 = 655360'

MSI(INFO): 'Property(S): ProductVersionLow.363843CE_60C8_4066_8093_68BA5A039B17 = 1377697793'

MSI(INFO): 'Property(S): DirectoryTable_x86.363843CE_60C8_4066_8093_68BA5A039B17 = DirectoryTable'

MSI(INFO): 'Property(S): OfficeMUICommonFeatureGroup_1031_Ref = 0'

MSI(INFO): 'Property(S): MiscIcon_Ref = 0'

MSI(INFO): 'Property(S): OfficeMUIFeatureGroup_1031_Ref = 0'

MSI(INFO): 'Property(S): AdminProperties = ARPSYSTEMCOMPONENT'

MSI(INFO): 'Property(S): SecureCustomProperties = DIAGNOSE;DWLANGUAGE;ERRORSUPPORTTEXT;LAUNCHEDBYSETUPEXE;LOGVERBOSE;PIDKEY;SETUPHELPFILEDIR;SETUPINTLDLLDIRECTORY;SETUPPSSHELPFILEDIR;SETUPSUPPORTURL'

MSI(INFO): 'Property(S): MsiHiddenProperties = PIDKEY'

MSI(INFO): 'Property(S): PackageCode = {C44D765D-F538-4F40-A3A6-25387973AEB1}'

MSI(INFO): 'Property(S): ProductState = 5'

MSI(INFO): 'Property(S): REBOOT = ReallySuppress'

MSI(INFO): 'Property(S): MSIRESTARTMANAGERCONTROL = Disable'

MSI(INFO): 'Property(S): SETUPEXEINSTALLUILANGUAGE = 1031'

MSI(INFO): 'Property(S): CURRENTDIRECTORY = C:\Users\Elkantar\AppData\Local\Temp\OWPBF5A.tmp'

MSI(INFO): 'Property(S): CLIENTUILEVEL = 3'

MSI(INFO): 'Property(S): MSICLIENTUSESEXTERNALUI = 1'

MSI(INFO): 'Property(S): CLIENTPROCESSID = 6300'

MSI(INFO): 'Property(S): MsiSystemRebootPending = 1'

MSI(INFO): 'Property(S): PRODUCTLANGUAGE = 1031'

MSI(INFO): 'Property(S): VersionDatabase = 200'

MSI(INFO): 'Property(S): VersionMsi = 5.00'

MSI(INFO): 'Property(S): VersionNT = 601'

MSI(INFO): 'Property(S): WindowsBuild = 7601'

MSI(INFO): 'Property(S): ServicePackLevel = 1'

MSI(INFO): 'Property(S): ServicePackLevelMinor = 0'

MSI(INFO): 'Property(S): MsiNTProductType = 1'

MSI(INFO): 'Property(S): WindowsVolume = C:\'

MSI(INFO): 'Property(S): System16Folder = C:\Windows\system\'

MSI(INFO): 'Property(S): RemoteAdminTS = 1'

MSI(INFO): 'Property(S): TempFolder = C:\Users\Elkantar\AppData\Local\Temp\'

MSI(INFO): 'Property(S): AppDataFolder = C:\Users\Elkantar\AppData\Roaming\'

MSI(INFO): 'Property(S): FavoritesFolder = C:\Users\Elkantar\Favorites\'

MSI(INFO): 'Property(S): NetHoodFolder = C:\Users\Elkantar\AppData\Roaming\Microsoft\Windows\Network Shortcuts\'

MSI(INFO): 'Property(S): PersonalFolder = C:\Users\Elkantar\Documents\'

MSI(INFO): 'Property(S): PrintHoodFolder = C:\Users\Elkantar\AppData\Roaming\Microsoft\Windows\Printer Shortcuts\'

MSI(INFO): 'Property(S): RecentFolder = C:\Users\Elkantar\AppData\Roaming\Microsoft\Windows\Recent\'

MSI(INFO): 'Property(S): SendToFolder = C:\Users\Elkantar\AppData\Roaming\Microsoft\Windows\SendTo\'

MSI(INFO): 'Property(S): TemplateFolder = C:\ProgramData\Microsoft\Windows\Templates\'

MSI(INFO): 'Property(S): LocalAppDataFolder = C:\Users\Elkantar\AppData\Local\'

MSI(INFO): 'Property(S): MyPicturesFolder = C:\Users\Elkantar\Pictures\'

MSI(INFO): 'Property(S): AdminToolsFolder = C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Administrative Tools\'

MSI(INFO): 'Property(S): StartupFolder = C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\'

MSI(INFO): 'Property(S): ProgramMenuFolder = C:\ProgramData\Microsoft\Windows\Start Menu\Programs\'

MSI(INFO): 'Property(S): StartMenuFolder = C:\ProgramData\Microsoft\Windows\Start Menu\'

MSI(INFO): 'Property(S): DesktopFolder = C:\Users\Public\Desktop\'

MSI(INFO): 'Property(S): FontsFolder = C:\Windows\Fonts\'

MSI(INFO): 'Property(S): GPTSupport = 1'

MSI(INFO): 'Property(S): OLEAdvtSupport = 1'

MSI(INFO): 'Property(S): ShellAdvtSupport = 1'

MSI(INFO): 'Property(S): Intel = 6'

MSI(INFO): 'Property(S): PhysicalMemory = 3033'

MSI(INFO): 'Property(S): VirtualMemory = 3869'

MSI(INFO): 'Property(S): AdminUser = 1'

MSI(INFO): 'Property(S): MsiTrueAdminUser = 1'

MSI(INFO): 'Property(S): LogonUser = Elkantar'

MSI(INFO): 'Property(S): UserSID = S-1-5-21-231036219-3607646422-451852890-1002'

MSI(INFO): 'Property(S): UserLanguageID = 1031'

MSI(INFO): 'Property(S): ComputerName = ELKANTAR-PC'

MSI(INFO): 'Property(S): SystemLanguageID = 1031'

MSI(INFO): 'Property(S): ScreenX = 1024'

MSI(INFO): 'Property(S): ScreenY = 768'

MSI(INFO): 'Property(S): CaptionHeight = 22'

MSI(INFO): 'Property(S): BorderTop = 1'

MSI(INFO): 'Property(S): BorderSide = 1'

MSI(INFO): 'Property(S): TextHeight = 16'

MSI(INFO): 'Property(S): TextInternalLeading = 3'

MSI(INFO): 'Property(S): ColorBits = 32'

MSI(INFO): 'Property(S): TTCSupport = 1'

MSI(INFO): 'Property(S): Time = 19:21:00'

MSI(INFO): 'Property(S): Date = 12.03.2013'

MSI(INFO): 'Property(S): MsiWin32AssemblySupport = 6.1.7601.17514'

MSI(INFO): 'Property(S): RedirectedDllSupport = 2'

MSI(INFO): 'Property(S): MsiRunningElevated = 1'

MSI(INFO): 'Property(S): Privileged = 1'

MSI(INFO): 'Property(S): USERNAME = Elkantar'

MSI(INFO): 'Property(S): Installed = 00:00:00'

MSI(INFO): 'Property(S): DATABASE = C:\Windows\Installer\728f3d.msi'

MSI(INFO): 'Property(S): OriginalDatabase = C:\Windows\Installer\728f3d.msi'

MSI(INFO): 'Property(S): UILevel = 2'

MSI(INFO): 'Property(S): Preselected = 1'

MSI(INFO): 'Property(S): ACTION = INSTALL'

MSI(INFO): 'Property(S): ROOTDRIVE = G:\'

MSI(INFO): 'Property(S): CostingComplete = 1'

MSI(INFO): 'Property(S): OutOfDiskSpace = 0'

MSI(INFO): 'Property(S): OutOfNoRbDiskSpace = 0'

MSI(INFO): 'Property(S): PrimaryVolumeSpaceAvailable = 0'

MSI(INFO): 'Property(S): PrimaryVolumeSpaceRequired = 0'

MSI(INFO): 'Property(S): PrimaryVolumeSpaceRemaining = 0'

MSI(INFO): 'Property(S): HxDs_Tmp_3643236F_FC70_11D3_A536_0090278A1BB8 = C:\Users\Elkantar\AppData\Local\Temp\Hx9FC9.tmp'

MSI(INFO): 'Property(S): HxDs_Tmp_Hash_3643236F_FC70_11D3_A536_0090278A1BB8 = CD20F4C36FE177A5C183897030AA28C7E5C3A18F6D4B29'

MSI(INFO): '=== Protokollierung beendet: 12.03.2013 19:21:00 ==='

MSI(COMMONDATA): '1: 2 2: 0 '

MSI(COMMONDATA): '1: 2 2: 1 '

MSI(TERMINATE): '<NULL>'

Successfully rolled back install of package: OfficeMUI.de-de path:\MSOCache\All Users\{90140000-006E-0407-0000-0000000FF1CE}-D\OfficeMUI.msi

Error attaching to OSE, error 0x00000000

Stopping running ose

Error stopping OSE, error 0x800706be

LIS: start uncaching for download "{90140000-0015-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-0015-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-0016-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-0016-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-0018-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-0018-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-0019-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-0019-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-001A-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-001A-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-001B-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-001B-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-002C-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-002C-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-0044-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-0044-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-006E-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-006E-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-00A1-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-00A1-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{90140000-00BA-0407-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{90140000-00BA-0407-0000-0000000FF1CE}-D"

LIS: start uncaching for download "{91140000-0011-0000-0000-0000000FF1CE}-D"

LIS: finished uncaching for download "{91140000-0011-0000-0000-0000000FF1CE}-D"

Error attaching to OSE, error 0x00000000

Stopping running ose

SystemRestore : Attempting to cancelling System-Restore-Point for Product [Microsoft Office Professional Plus 2010] (with RestorePointType [0, Installed]).

SystemRestore : Successfully cancelled System-Restore-Point for Product [Microsoft Office Professional Plus 2010] (with RestorePointType [0, Installed]).

Showing completion dialog.

Reboot requested if needed.

No reboot is needed.

Catalyst execution finished: 03/12/2013 19:21:07. Return code: 1603.

PERF: TickCount=7809176 Name=RunSetup Description=End function

Gruß

Wäre es nun möglich meine Tabelle vorher mit meiner Excel abzugleichen und nur neue Dateien in der Tabelle anfügen und nicht mehr vorhandene Dateien trotzdem in der Excel bestehen zu lassen und nicht zu löschen?

Naja, würde schon gehen.

Dazu müssen jedoch den ganzen Code ablaufen lassen, außer der Ausgabe, und bekommen so ein Array NEU mit allen Dateien die da sind.

Nun müssen wir die vorhandenen Daten in ein Array ALT einlesen und dann müssen wir für jede Datei in NEU prüfen ob diese in ALT vorhanden ist, wenn nicht, dann die Daten aus NEU in ein Array HINZU übertragen.

Dieses HINZU können wir dann unter die Daten schreiben...

Andreas.

Hallo Berthold,

du kannst nach dem wichtigsten Kriterium suchen lassen wie in dem Code und dann wenn Not rngC is nothing in einem IF-Statement die anderen Kriterien abfragen.

Schneller geht es, wenn du die Daten in ein Array schreibst und dann dieses Array durchläufst und gleich nach den 3 Kriterien suchst. Wenn gefunden, dann schreibe in ein neues Array. Wenn die Suche durch ist, kannst du das ganze Array mit den gefundenen
Werten an die Listbox übergeben mit

Listbox1.List=myArray

Claus