Excel


Miles21

Grünschnabel
--------------------------------------------------------------------------------

Hallo zusammen,

ich würde gern das Marko in ein VB.NET umschreiben kann mir jemand helfen?

Public Function GetXLFiles(ByRef astrXLFiles() As String, _
ByVal strLookIn As String, Optional fSearchSubfolders _
As Boolean = False) As Boolean

Dim nFilesCnt As Long
Dim nFile As Long
Dim nCounter As Long
Dim strFileName As String

On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = strLookIn
.SearchSubFolders = fSearchSubfolders
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks

If .Execute(SortBy:=msoSortByFileName, SortOrder:= _
msoSortOrderAscending, AlwaysAccurate:=True) > 0 Then

nFilesCnt = .FoundFiles.Count
ReDim astrXLFiles(0 To nFilesCnt - 1)

nCounter = -1
For nFile = 1 To nFilesCnt
strFileName = .FoundFiles(nFile)
If Len(Dir$(strFileName)) > 0 Then
nCounter = nCounter + 1
astrXLFiles(nCounter) = strFileName
End If
Next

If nCounter > -1 Then
ReDim Preserve astrXLFiles(0 To nCounter)
GetXLFiles = True
End If
End If
End With
On Error GoTo 0
End Function
Public Sub Demo()
Dim strPath As String
Dim astrXLFiles() As String
Dim nFile As Long

strPath = "c:\test\"

If Len(Dir$(strPath, vbDirectory)) > 0 Then
If GetXLFiles(astrXLFiles(), strPath, True) Then

For nFile = 0 To UBound(astrXLFiles)
Debug.Print astrXLFiles(nFile)
Workbooks.Open astrXLFiles(nFile), UpdateLinks:=3
ActiveWorkbook.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveWorkbook.Close

Next

Erase astrXLFiles
Else
MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
vbCrLf & strPath & vbCrLf & "gefunden!", _
vbInformation, "DEMO"
End If
Else
MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
"existiert nicht!", vbInformation, "DEMO"
End If
End Sub

DANKE im Vorraus

Miles
 

Julian Maicher

Erfahrenes Mitglied
Wobei sollen wir dir denn helfen?
Fang doch einfach mal selber an und wenn du konkrete Fragen hast, dann kannst du sie hier stellen.
Ich glaube nicht, dass sich einer die Mühe macht und dir das komplette konvertieren abnimmt :)