D

Problem Makro
Dateipfad in Kopfzeile eintragen Sub PfadInKopfzeile()
Worksheets(1).PageSetUp.LeftHeader = ThisWorkbook.Fullname
End Sub
prüfen, ob Datei vorhanden If Dir("c:\test.xls") <> "" Then
  MsgBox "Datei vorhanden"
Else
  MsgBox "Datei fehlt"
End If
von Bernd Held:

Function FileExist(Filename As String) As Boolean
   FileExist = False
   If Len(Filename) > 0 Then FileExist = (Dir(Filename) <> "")
   Exit Function
End Function

Sub DateiDa()
s = FileExist("C:\eigene Dateien\Mappe.xls")
MsgBox s
End Sub

Dateien eines Verzeichnisses auflisten 'Aus der Onlinehilfe von Excel2000 mit kleinen Anpassungen:

Sub Dateien_auflisten()
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\temp")
Set fc = f.Files
i = 0
For Each f1 In fc
i = i + 1
ActiveSheet.Cells(i, 1) = f1.Name
ActiveSheet.Cells(i, 2) = FileLen(f1)
ActiveSheet.Cells(i, 3) = FileDateTime(f1)
Next
End Sub

Dateiattribute ändern Sub Dateiattribut()
ChDir "C:\"
DATEI = "C:\Temp\Test.xls"
SetAttr DATEI, vbNormal
End Sub

Weitere Attribute:
vbNormal  0 Normal (Voreinstellung)
vbReadOnly 1 Schreibgeschützt
vbHidden 2 Versteckt
vbSystem 4 Systemdatei
vbArchive 32 Datei wurde seit dem letzten Speichern geändert
Dateien auf Festplatte löschen Sub löschen()
ChDir "c:\"
Kill ("c:\temp\test.doc")
End Sub
Diskette in Laufwerk A 'von Bernd Held

Sub DisketteDrin()
Dim s as string
    On Error Resume Next
    If IsError(s = Dir("a:\", vbVolume)) = True Then
        MsgBox "Bitte eine Diskette einlegen!"
        Exit Sub
    End If
End Sub

größter Dateiname eines Textdokuments
(Zahlenwert)

Textdokumente in c:\Temp abgespeichert als 0001.txt, 0002.txt usw.
Andere Dateiendungen werden ignoriert.

Sub GrößteDateiNummer()
Dim fs, f, f1, fc, gf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\temp")
Set fc = f.Files
gf = 0
For Each f1 In fc
If Left(f1.Name, Len(f1.Name) - 4) > gf _
And IsNumeric(Left(f1.Name, Len(f1.Name) - 4)) _
And Right(f1.Name, 4) = ".txt" Then
gf = Left(f1.Name, Len(f1.Name) - 4)
End If
Next
MsgBox "Der höchste Dateiname lautet: " & gf
End Sub
Zahl in Datum umwandeln

Zahlen
10901 in 01.09.2001
bzw.
310801 in 31.08.2001
des selektierten Bereichs
Sub ZahlInDatum()
Dim c As Range
On Error Resume Next
For Each c In Selection
If Len(c) = 5 Then
c = DateSerial(Right(c, 2), Mid(c, 2, 2), Left(c, 1))
End If
If Len(c) = 6 Then
c = DateSerial(Right(c, 2), Mid(c, 3, 2), Left(c, 2))
End If
Next c
End Sub
Datum von Textbox als "richtiges" Datum zurückgeben ............
[a1]=datevalue(textbox1.text)
............


Meine aktuellsten Exceltipps finden Sie hier: