Frank said:
Could you please help, I like to open a text file and take its data which
are X, Y coordinates of a excel chart in to a excel datasheet. What I found
out is that I can use the VBA to open a text file and load its data to the
worksheet but I dont know how to load it in to a datasheet. Could anyone
help.
thank you in advance
Frank, hope this helps.
Gawain
' Declarations
Option Explicit
'==================================================================================
' Function : MacroReadFromFile
' Purpose : Reads from a file and put results into cells on a
worksheet
'
' Author : Gavin
' Date : 09-06-04
'
' Notes : Demo macro to show how to read stuff from a file into a
spreadsheet
' uses library funcs developed previously - copies are
below
'==============================================================================-
'
Sub MacroReadFromFile()
'
' Dim variables
Dim intFile As Integer
Dim strFileName As String
Dim strThisField As String
Dim strThisLine As String
Dim intCount As Integer
Dim intRow As Integer
Dim intCol As Integer
' -- For testing purposes, get the file to open from the active
cell
strFileName = ActiveCell
intCol = ActiveCell.Column
intRow = ActiveCell.Row
' -- For testing purposes, check we have what we think
MsgBox ActiveCell.Worksheet.Name
' -- Check aforementioned file exists
If (Not (FileLib_bFileExists(strFileName))) Then
MsgBox strFileName & " is not an existing file"
Exit Sub
End If
' -- Try and open it
intFile = FileLib_intOpenFile(strFileName, "Read")
If (intFile = 0) Then
' -- Whoops - error, go home early
MsgBox "Could not open " & strFileName
Exit Sub
End If
' -- Read in a line of text - use your own method if prefered!
strThisLine = FileLib_strGetTextLine(intFile)
intCount = 1
' -- Get each delimited field in the line
strThisField = StrLib_strGetNextField(strThisLine, ",")
While (strThisField <> "")
' ****** FRANK - this is probably the pertinent line
*****************
Worksheets(1).Cells(intRow + intCount, intCol) = strThisField
strThisField = StrLib_strGetNextField(strThisLine, ",")
intCount = intCount + 1
Wend
' -- close file
Close #intFile
End Sub
'==================================================================================
' Function : FileLib_intOpenFile
' Purpose : Opens a file for different binary access modes
'
' Author : Gavin
' Date : 28-Jun-97
'
' Recieves : 1. strFileName - The name of the file to open,
including the
'path
' 2. strAccess - The access mode
'
' Returns : The file handle
'
' Notes : Uses the FreeFile function to get the next available
file handle
' On error returns 0
'==============================================================================-
'
Public Function FileLib_intOpenFile(strFileName As String, strAccess
As String, Optional strType = "") As Integer
Dim intNextFileNumber As Integer
' set up error trapping
On Error GoTo FileLib_intOpenFile_Error
intNextFileNumber = FreeFile ' Get the next free file handle
Select Case strAccess
Case "Read"
Open strFileName For Binary Access Read As
#intNextFileNumber
Case "Write"
Open strFileName For Binary Access Write As
#intNextFileNumber
Case "WriteText"
Open strFileName For Output Access Write As
#intNextFileNumber
Case "AppendText"
Open strFileName For Append Access Write As
#intNextFileNumber
Case "Text"
Open strFileName For Input Access Read As
#intNextFileNumber
Case Else
Open strFileName For Binary As #intNextFileNumber
End Select
' Return the file handle
FileLib_intOpenFile = intNextFileNumber
Exit Function
' Error handler
FileLib_intOpenFile_Error:
FileLib_intOpenFile = 0
End Function
'==================================================================================
' Function : FileLib_strGetTextLine
' Purpose : Reads a line from a text file
'
' Author : Gavin
' Date : 28-Jun-97
'
' Recieves : 1. intFileHandle - the file number
'
' Returns : The next line with the crud removed
' Notes : For use rather that "Line Input" when the file pointer
' needs to be set
' : Reads the file character at a time until it finds an end
of line one
' But unlike the above function doesn't skip over escape
chars
' except the CR/LF
'
' Uses : 1. FileLib_bEndOfLine
'==============================================================================-
'
Public Function FileLib_strGetTextLine(intFileHandle As Integer) As
String
Dim lngFilePos As Long
' read in the line character by character until end of file
' or end of line
Dim strNextChar As String
Dim strNextLine As String
lngFilePos = Loc(intFileHandle)
Do While (lngFilePos < LOF(intFileHandle))
' Get the next charcter
' Check to see if its the end of the line
strNextChar = Input(1, #intFileHandle)
If (FileLib_bEndOfLine(strNextChar)) Then
Exit Do
End If
' Add this character to the string
strNextLine = strNextLine & strNextChar
' Reset the file position pointer
lngFilePos = Loc(intFileHandle)
Loop
' DOS uses char 13/10 as its eol marker, other systems 10
If (lngFilePos < LOF(intFileHandle)) Then
' Get the next character
strNextChar = Input(1, #intFileHandle)
' Reset the file position pointer
lngFilePos = Loc(intFileHandle)
' is is one of the white space ones
If (Asc(strNextChar) <> 10) Then
Seek #intFileHandle, lngFilePos
End If
End If
FileLib_strGetTextLine = strNextLine
End Function
'----------------------------------------------------------------------------------
' Function : FileLib_bEndOfLine
' Purpose : Checks to see if the character is a recognised end of
line one
'
' Author : Gavin
' Date : 28-Jun-97
'
' Recieves : 1. strChar - The character to check
'
' Returns : True if EOL else false
'-------------------------------------------------------------------------------
'
Private Function FileLib_bEndOfLine(strChar As String) As Boolean
Dim bEndOfLine As Boolean
If (strChar = "") Then
Exit Function
End If
Select Case Asc(strChar)
Case 10 ' Carriage return
bEndOfLine = True
Case 13 ' Line feed
bEndOfLine = True
Case Else
bEndOfLine = False
End Select
FileLib_bEndOfLine = bEndOfLine
End Function
'==================================================================================
' Function : FileLib_bFileExists
' Purpose : Sees if a file exists
'
' Author : Gavin
' Date : 25-Nov-98
'
' Recieves : 1. strFilename - the file name
'
' Returns : True if exists, else false
'==============================================================================-
'
Public Function FileLib_bFileExists(strFileName) As Boolean
Dim intResult As Integer ' Test variable
Dim bExists As Boolean
On Error GoTo FileLib_bFileExists_ERROR
bExists = True ' if doesn't exist, an error will occur then set to
false
intResult = GetAttr(strFileName)
FileLib_bFileExists_EXIT:
FileLib_bFileExists = bExists
Exit Function
FileLib_bFileExists_ERROR:
bExists = False
Resume FileLib_bFileExists_EXIT
End Function
'==================================================================================
' Function : StrLib_strGetNextField
' Purpose : Gets next field from a delimited string
'
' Author : Gavin
' Date : 27th March 2002
'
' Recieves : 1. strRecord - the string containing the fields
' 2. strDelim - The delimiter (defaults to a space: " ")
'
' Returns : The next field if there is one, else ""
'
' Notes : Removes the retrieved field from the source string
'==================================================================================
'
Public Function StrLib_strGetNextField(ByRef strRecord As String, _
Optional strDelim As String =
" ") As String
Dim intPtr As Integer
If (Len(Trim(strRecord)) = 0) Then
StrLib_strGetNextField = ""
Exit Function
End If
intPtr = InStr(strRecord, strDelim)
If (intPtr = 0) Then
' return whats left
StrLib_strGetNextField = strRecord
strRecord = ""
Exit Function
End If
StrLib_strGetNextField = Left(strRecord, intPtr - 1)
strRecord = Mid(strRecord, intPtr + Len(strDelim))
End Function
' -- StrLib_strGetNextField
