Text-Datei und Laufzeitfehler 52
23.03.2006 15:04:53
Jan
Ich wollte 2 Variablen in eine Text-Datei speichern. Leider bekomme ich nicht das Code Snippet was ich im Internet gefunden habe zum laufen. Mit einer Variable (z.b.
Sub Bewerbersave) geht das gut doch sobald ich versuche das Makro nocheinmal auszuführen oder eine andere Variable abzu speichern funzt es nicht und ich bekomme den Laufzeitfehler: Dateiname oder Nummer falsch.
viele Grüsse Jan
Function FullNameToPath(sFullName As String) As String
''' does not include trailing backslash
Dim k As Integer
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
If k < 1 Then
FullNameToPath = ""
Else
FullNameToPath = Mid(sFullName, 1, k - 1)
End If
End Function
Function FullNameToFileName(sFullName As String) As String
Dim k As Integer
Dim sTest As String
If InStr(1, sFullName, "[") > 0 Then
k = InStr(1, sFullName, "[")
sTest = Mid(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
Else
For k = Len(sFullName) To 1 Step -1
If Mid(sFullName, k, 1) = "\" Then Exit For
Next k
sTest = Mid(sFullName, k + 1, Len(sFullName) - k)
End If
FullNameToFileName = sTest
End Function
Function FileExists(ByVal FileSpec As String) As Boolean
' by Karl Peterson MS MVP VB
Dim Attr As Long
' Guard against bad FileSpec by ignoring errors
' retrieving its attributes.
On Error Resume Next
Attr = GetAttr(FileSpec)
If Err.Number = 0 Then
' No error, so something was found.
' If Directory attribute set, then not a file.
FileExists = Not ((Attr And vbDirectory) = vbDirectory)
End If
End Function
Function SaveSetting(sFile As String, sName As String, _
Optional sValue As String) As Boolean
Dim iFileNumA As Long
Dim iFileNumB As Long
Dim sXFile As String
Dim sVarName As String
Dim sVarValue As String
Dim lErrLast As Long
' assume false unless variable is successfully saved
SaveSetting = False
' add this workbook's path if not specified
If Not IsFullName(sFile) Then
sFile = ThisWorkbook.Path & "\" & sFile
sXFile = ThisWorkbook.Path & "\X" & sFile
Else
sXFile = FullNameToPath(sFile) & "\X" & FullNameToFileName(sFile)
End If
' open text file to read settings
If FileExists(sFile) Then
'replace existing settings file
iFileNumA = FreeFile
Open sFile For Input As iFileNumA
iFileNumB = FreeFile
Open sXFile For Output As iFileNumB
Do While Not EOF(iFileNumA)
Input #iFileNumA, sVarName, sVarValue
If sVarName <> sName Then
Write #iFileNumB, sVarName, sVarValue
End If
Loop
Write #iFileNumB, sName, sValue
SaveSetting = True
Close #iFileNumA
Close #iFileNumB
FileCopy sXFile, sFile
Kill sXFile
Else
' make new file
iFileNumB = FreeFile
Open sFile For Output As iFileNumB
Write #iFileNumB, sName, sValue
SaveSetting = True
Close #iFileNumB
End If
End Function
End Sub
Sub Positionsave()
Dim bTest As Boolean
Dim sPosition As String
sPosition = Range("D3")
bTest = SaveSetting("ub_settings.txt", "Position", sPosition)
End Sub
Sub Bewerbersave()
Dim bTest As Boolean
Dim sBewerber As String
sBewerber = Range("C3")
bTest = SaveSetting("ub_settings.txt", "Bewerber", sBewerber)
End Sub