Function which accesses 13 different file manipulation routines including saving text to a known or

by Joe Dacy II (6 Submissions)
Category: Files/File Controls/Input/Output
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 6^th March 2001
Date Added: Mon 8^th February 2021
Rating: (1 Votes)

Function which accesses 13 different file manipulation routines including saving text to a known or unknown (selected) file, opening text

API Declarations
'EG: Public CDBox As Object 'Set CDBox = Form1.CommonDialog1 ' Other variables as needed

Rate Function which accesses 13 different file manipulation routines including saving text to a known or



On Error GoTo CnlError

' See individual type for how to transfer variable information and what text string the function returns.

' Case 1 Opens a Known File
' Case 2 Saves Text to a Known File
' Case 3 Opens an Unknown File Using a CommonDialog Box Object
' Case 4 Saves Text Using a CommonDialog Box Object
' Case 5 Retrieves a FileName
' Case 6 Retrieves a FileTitle
' Case 7  Retrieves a file's path
' Case 8 Retrieves File Name Without File Extension or Path
' Case 9 Retrieves File Name of a Known File Without File Extension or Path
' Case 10 Retrieves the Character Count of a Known File As a String (Len)
' Case 11 Retrieve the Character Count of an Unknown File (Len)
' Case 12 Retrieve the Line Count of an Unknown File
' Case 13 Retrieves the Line Count of a Known File As a String
Dim aFileNum As Long
Dim SomeText As String
Dim TempText As String
Dim WR As String
Dim AObject As Object
Set AObject = aCDB
WR = Chr$(13) & Chr$(10)
SomeText = ""
TempText = ""
aFileNum = FreeFile

Select Case aType
Case 1 'Opens a Known File
' aPath = the full pathname to the known file
' aFile = ""
' aFilter = ""
' aCDB = Nothing
' Returns the text in the file

Open aPath For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
SomeText = SomeText & TempText & WR
Loop
Close #aFileNum
OpenSaveFiles = SomeText
GoTo ImDone

Case 2 'Saves Text to a Known File
' aPath = the full pathname to the known file
' aFile = the text to be saved
' aFilter = ""
' aCDB = Nothing
' Returns "Success"

Open aPath For Output As #aFileNum
Print #aFileNum, aFile
Close #aFileNum
OpenSaveFiles = "Success"
GoTo ImDone


Case 3 'Opens an Unknown File
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns the text in the file or "" if cancelled

AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
Open AObject.FileName For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
SomeText = SomeText & TempText & WR
Loop
Close #aFileNum
OpenSaveFiles = SomeText
GoTo ImDone
End If

Case 4 'Saves Text Using CDB
' aPath = the InitDir path
' aFile = the text to be saved
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns "Success" or "" if cancelled

AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.Flags = &H2&
AObject.ShowSave
If AObject.FileName <> "" Then
Open AObject.FileName For Output As #aFileNum
Print #aFileNum, aFile
Close #aFileNum
OpenSaveFiles = "Success"
GoTo ImDone
End If

Case 5 'Retrieves a FileName
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns select filename or "" if cancelled
AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
OpenSaveFiles = AObject.FileName
GoTo ImDone
End If

Case 6 'Retrieves a FileTitle
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns select filetitle or "" if cancelled

AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
OpenSaveFiles = AObject.FileTitle
GoTo ImDone
End If

Case 7 ' Retrieves a file's path
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns selected file's folder path or "" if cancelled

Dim fAf As Integer
Dim fNf As Integer
Dim fChf As String
Dim fWheref As Integer
AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
fAf = Len(AObject.FileName)
For fNf = 1 To fAf
fChf = Mid(AObject.FileName, fNf, 1)
    If fChf = "\" Or fChf = "/" Then
    fWheref = fNf
      End If
Next
OpenSaveFiles = Mid(AObject.FileName, 1, fWheref - 1)
GoTo ImDone
End If

Case 8 'Retrieves File Name Without File Extension or Path
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns selected file's basic name or "" if cancelled
Dim ExtNum As Integer
ExtNum = 0
Dim eAe As Integer
Dim eNe As Integer
Dim eChe As String

AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then

eAe = Len(AObject.FileTitle)
For eNe = eAe To 1 Step -1
ExtNum = ExtNum + 1
eChe = Mid(AObject.FileTitle, eNe, 1)
    If eChe = "." Then
    GoTo FoundIt
    End If
Next
FoundIt:

OpenSaveFiles = Mid(AObject.FileTitle, 1, Len(AObject.FileTitle) - ExtNum)
GoTo ImDone
End If

Case 9 'Retrieves File Name of a Known File Without File Extension or Path
' aPath = the full pathname OR filetitle of the known file
' aFile = ""
' aFilter = ""
' aCDB = Nothing
' Returns the basic name of the known file or filetitle

Dim ExtNum2 As Integer
ExtNum2 = 0
Dim kAe As Integer
Dim kNe As Integer
Dim kChe As String
Dim kWhere As Integer
Dim kStore As String
kStore = ""
kWhere = 0

For kNe = 1 To Len(aPath)
kChe = Mid(aPath, kNe, 1)
If kChe = "\" Or kChe = "/" Then
kWhere = kNe
End If
Next

If kWhere = 0 Then
kStore = aPath
Else
kWhere = kWhere + 1
kStore = Mid(aPath, kWhere, Len(aPath))
End If
kAe = Len(kStore)
For kNe = kAe To 1 Step -1
ExtNum2 = ExtNum2 + 1
kChe = Mid(kStore, kNe, 1)
    If kChe = "." Then
    GoTo FoundIt2
    End If
Next
FoundIt2:
OpenSaveFiles = Mid(kStore, 1, Len(kStore) - ExtNum2)

GoTo ImDone

Case 10 'Retrieves the Character Count of a Known File As a String
' aPath = the full pathname to the known file
' aFile = ""
' aFilter = ""
' aCDB = Nothing
' Returns the character count of the file as a string
Dim CCount As Integer
Open aPath For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
SomeText = SomeText & TempText & WR
Loop
Close #aFileNum
CCount = Len(SomeText)
OpenSaveFiles = CStr(CCount)
GoTo ImDone

Case 11 'Retrieve the Character Count of an Unknown File
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns the character count of the file as a string or "" if cancelled

Dim KCount As Integer
AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
Open AObject.FileName For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
SomeText = SomeText & TempText & WR
Loop
Close #aFileNum
KCount = Len(SomeText)
OpenSaveFiles = CStr(KCount)
GoTo ImDone
End If

Case 12 'Retrieve the Line Count of an Unknown File
' aPath = the InitDir path
' aFile = ""
' aFilter = the filter for the CommonDialog Box
' aCDB = the CommonDialog box accessed (as Object)
' Returns the line count of the file as a string or "" if cancelled

Dim LCount As Integer
LCount = 0
AObject.FileName = ""
AObject.Filter = aFilter
AObject.InitDir = aPath
AObject.ShowOpen
If AObject.FileName <> "" Then
Open AObject.FileName For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
LCount = LCount + 1
Loop
Close #aFileNum
OpenSaveFiles = CStr(LCount)
GoTo ImDone
End If

Case 13 'Retrieves the Line Count of a Known File As a String
' aPath = the full pathname to the known file
' aFile = ""
' aFilter = ""
' aCDB = Nothing
' Returns the line count of the file as a string
Dim UCount As Integer
UCount = 0
Open aPath For Input As #aFileNum
Do Until EOF(aFileNum) = True
Line Input #aFileNum, TempText
UCount = UCount + 1
Loop
Close #aFileNum
OpenSaveFiles = CStr(UCount)
GoTo ImDone
End Select

GoTo ImDone
CnlError:
OpenSaveFiles = ""
ImDone:
SomeText = ""
TempText = ""


End Function

Download this snippet Add to My Saved Code

Function which accesses 13 different file manipulation routines including saving text to a known or Comments

No comments have been posted about Function which accesses 13 different file manipulation routines including saving text to a known or. Why not be the first to post a comment about Function which accesses 13 different file manipulation routines including saving text to a known or.

Function which accesses 13 different file manipulation routines including saving text to a known or

Function which accesses 13 different file manipulation routines including saving text to a known or Comments

Post your comment

Difficulty