15.1 通用的简化
代码
代码
代码
代码
代码
代码
代码
15.2 在Excel中打开文本文件
15.3 向工作表导入数据
15.4 自动化文本文件
代码清单15.1: 打开分界文件的例子
代码
'代码清单15.1: 打开分界文件的例子
Sub TestOpenDelimitedFile()
Dim wb As Workbook
Dim vFields As Variant
'the third column of the orders file
'is a date column (mm/dd/yyyy)
'the rest are general (default)
vFields = Array(Array(3, xlMDYFormat))
Set wb = OpenDelimitedFile("C:\tab delimited orders.txt", 2, xlTextQualifierNone, False, vbTab, vFields)
Set wb = Nothing
End Sub
Function OpenDelimitedFile(sFile As String, _
lStartRow As Long, _
TxtQualifier As XlTextQualifier, _
bConsecutiveDelimiter As Boolean, _
sDelimiter As String, _
Optional vFieldInfo As Variant) As Workbook
On Error GoTo ErrHandler
If IsMissing(vFieldInfo) Then
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
TextQualifier:=TxtQualifier, _
consecutiveDelimiter:=bConsecutiveDelimiter, _
other:=True, _
otherchar:=sDelimiter
Else
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
TextQualifier:=TxtQualifier, _
consecutiveDelimiter:=bConsecutiveDelimiter, _
other:=True, _
otherchar:=sDelimiter, _
fieldInfo:=vFieldInfo
End If
Set OpenDelimitedFile = ActiveWorkbook
ExitPoint:
Exit Function
ErrHandler:
Set OpenDelimitedFile = Nothing
Resume ExitPoint
End Function
Sub TestOpenDelimitedFile()
Dim wb As Workbook
Dim vFields As Variant
'the third column of the orders file
'is a date column (mm/dd/yyyy)
'the rest are general (default)
vFields = Array(Array(3, xlMDYFormat))
Set wb = OpenDelimitedFile("C:\tab delimited orders.txt", 2, xlTextQualifierNone, False, vbTab, vFields)
Set wb = Nothing
End Sub
Function OpenDelimitedFile(sFile As String, _
lStartRow As Long, _
TxtQualifier As XlTextQualifier, _
bConsecutiveDelimiter As Boolean, _
sDelimiter As String, _
Optional vFieldInfo As Variant) As Workbook
On Error GoTo ErrHandler
If IsMissing(vFieldInfo) Then
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
TextQualifier:=TxtQualifier, _
consecutiveDelimiter:=bConsecutiveDelimiter, _
other:=True, _
otherchar:=sDelimiter
Else
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
TextQualifier:=TxtQualifier, _
consecutiveDelimiter:=bConsecutiveDelimiter, _
other:=True, _
otherchar:=sDelimiter, _
fieldInfo:=vFieldInfo
End If
Set OpenDelimitedFile = ActiveWorkbook
ExitPoint:
Exit Function
ErrHandler:
Set OpenDelimitedFile = Nothing
Resume ExitPoint
End Function
代码清单15.2: 打开固定长度文件的例子
代码
'代码清单15.2: 打开固定长度文件的例子
Sub TestOpenFixedWidthFile()
Dim wb As Workbook
Dim vFields As Variant
'the third column of the orders file
'is a date column (mm/dd/yyyy).
'the rest are general (default)
vFields = Array( _
Array(0, xlGeneralFormat), _
Array(7, xlGeneralFormat), _
Array(21, xlMDYFormat), _
Array(32, xlGeneralFormat), _
Array(43, xlGeneralFormat))
Set wb = OpenFixedWidthFile("C:\fixed width orders.txt", 1, vFields)
Set wb = Nothing
End Sub
Function OpenFixedWidthFile(sFile As String, _
lStartRow As Long, _
vFieldInfo As Variant) As Workbook
On Error GoTo ErrHandler
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
fieldInfo:=vFieldInfo
Set OpenFixedWidthFile = ActiveWorkbook
ExitPoint:
Exit Function
ErrHandler:
Set OpenFixedWidthFile = Nothing
Resume ExitPoint
End Function
Sub TestOpenFixedWidthFile()
Dim wb As Workbook
Dim vFields As Variant
'the third column of the orders file
'is a date column (mm/dd/yyyy).
'the rest are general (default)
vFields = Array( _
Array(0, xlGeneralFormat), _
Array(7, xlGeneralFormat), _
Array(21, xlMDYFormat), _
Array(32, xlGeneralFormat), _
Array(43, xlGeneralFormat))
Set wb = OpenFixedWidthFile("C:\fixed width orders.txt", 1, vFields)
Set wb = Nothing
End Sub
Function OpenFixedWidthFile(sFile As String, _
lStartRow As Long, _
vFieldInfo As Variant) As Workbook
On Error GoTo ErrHandler
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlDelimited, _
fieldInfo:=vFieldInfo
Set OpenFixedWidthFile = ActiveWorkbook
ExitPoint:
Exit Function
ErrHandler:
Set OpenFixedWidthFile = Nothing
Resume ExitPoint
End Function
15.5 原始方法—拷贝/粘贴
代码清单15.3: TextToColumns例子
代码
'代码清单15.3: TextToColumns例子
Sub TestTextToColumns()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Text to Columns").Range("A20").CurrentRegion
'Converts text to columns but
'leaves the original text untouched
CSVTextToColumns rg, rg.Offset(15, 0)
End Sub
'Converts text to columns assuming the text
'to be converted is comma delimited.
Sub CSVTextToColumns(rg As Range, Optional rgDestination As Range)
If IsMissing(rgDestination) Or rgDestination Is Nothing Then
rg.TextToColumns , xlDelimited, , , , , True
Else
rg.TextToColumns rgDestination, xlDelimited, , , , , True
End If
End Sub
Sub TestTextToColumns()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Text to Columns").Range("A20").CurrentRegion
'Converts text to columns but
'leaves the original text untouched
CSVTextToColumns rg, rg.Offset(15, 0)
End Sub
'Converts text to columns assuming the text
'to be converted is comma delimited.
Sub CSVTextToColumns(rg As Range, Optional rgDestination As Range)
If IsMissing(rgDestination) Or rgDestination Is Nothing Then
rg.TextToColumns , xlDelimited, , , , , True
Else
rg.TextToColumns rgDestination, xlDelimited, , , , , True
End If
End Sub
15.6 打开隐藏文件
15.6.1 打开事物
代码清单15.4: VBA Open语句的例子
代码
'代码清单15.4: VBA Open语句的例子
Sub SimpleOpenExamples()
Dim lInputFile As Long
Dim lOutputFile As Long
Dim lAppendFile As Long
'Get a valid file number
lInputFile = FreeFile
'Open MyInputFile.txt for input
Open "C:\MyInput.txt" For Input As #lInputFile
'Get another avlid file number
lOutputFile = FreeFile
'Create a new file for output
Open "C:\MyNewOutput.txt" For Output As #lOutputFile
'Get another valid file number
lAppendFile = FreeFile
'Open myAppendFile.txt to append data to it
'or create new file if MyAppendFile doesn't exist
Open "C:\MyNewOutput.txt" For Append As #lAppendFile
'close the files
Close lInputFile, lOutputFile, lAppendFile
End Sub
Sub SimpleOpenExamples()
Dim lInputFile As Long
Dim lOutputFile As Long
Dim lAppendFile As Long
'Get a valid file number
lInputFile = FreeFile
'Open MyInputFile.txt for input
Open "C:\MyInput.txt" For Input As #lInputFile
'Get another avlid file number
lOutputFile = FreeFile
'Create a new file for output
Open "C:\MyNewOutput.txt" For Output As #lOutputFile
'Get another valid file number
lAppendFile = FreeFile
'Open myAppendFile.txt to append data to it
'or create new file if MyAppendFile doesn't exist
Open "C:\MyNewOutput.txt" For Append As #lAppendFile
'close the files
Close lInputFile, lOutputFile, lAppendFile
End Sub
15.6.2 文件I/O
代码清单15.5: 一个使用WRITE#和INPUT#的例子
代码
'代码清单15.5: 一个使用WRITE#和INPUT#的例子
Sub TestWriteInput()
WriteExample
InputExample
End Sub
'Creates a comma-delimited file based
'on a range in Excel that is 8
'columns wide
Sub WriteExample()
Dim lOutputFile As Long
Dim rg As Range
'Set rg to refer to upper-left cell of range
Set rg = ThisWorkbook.Worksheets(1).Range("A1")
'Get a valid file number
lOutputFile = FreeFile
'Create a new file for output
Open "C:\Write Example.txt" For Output As #lOutputFile
'Loop until there isn't any data in the first column
Do Until IsEmpty(rg)
'Write the data to the file
Write #lOutputFile, rg.Value, _
rg.Offset(0, 1).Value, _
rg.Offset(0, 2).Value, _
rg.Offset(0, 3).Value, _
rg.Offset(0, 4).Value, _
rg.Offset(0, 5).Value, _
rg.Offset(0, 6).Value, _
rg.Offset(0, 7).Value
'Move down to next row
Set rg = rg.Offset(1, 0)
Loop
Set rg = Nothing
Close lOutputFile
End Sub
Sub InputExample()
Dim lInputFile As Long
Dim rg As Range
'variant variables for reading
'from text file
Dim v1, v2, v3, v4
Dim v5, v6, v7, v8
'set rg to refer to upper-left cell of range
Set rg = ThisWorkbook.Worksheets(2).Range("a1")
'clear any existing data
rg.CurrentRegion.ClearContents
'Get a valid file number
lInputFile = FreeFile
'create a new file for input
Open "C:\Input Example.txt" For Input As #lInputFile
'loop until you hit the end of file
Do Until EOF(lInputFile)
'Read the data to the file
'have to read into a variable - an't assign
'directly to a range
Input #lInputFile, v1, v2, v3, v4, v5, v6, v7, v8
'Transfer values to that worksheet
rg.Value = v1
rg.Offset(0, 1).Value = v2
rg.Offset(0, 2).Value = v3
rg.Offset(0, 3).Value = v4
rg.Offset(0, 4).Value = v5
rg.Offset(0, 5).Value = v6
rg.Offset(0, 6).Value = v7
rg.Offset(0, 7).Value = v8
'move down to next row
Set rg = rg.Offset(1, 0)
Loop
Set rg = Nothing
Close lInputFile
End Sub
Sub TestWriteInput()
WriteExample
InputExample
End Sub
'Creates a comma-delimited file based
'on a range in Excel that is 8
'columns wide
Sub WriteExample()
Dim lOutputFile As Long
Dim rg As Range
'Set rg to refer to upper-left cell of range
Set rg = ThisWorkbook.Worksheets(1).Range("A1")
'Get a valid file number
lOutputFile = FreeFile
'Create a new file for output
Open "C:\Write Example.txt" For Output As #lOutputFile
'Loop until there isn't any data in the first column
Do Until IsEmpty(rg)
'Write the data to the file
Write #lOutputFile, rg.Value, _
rg.Offset(0, 1).Value, _
rg.Offset(0, 2).Value, _
rg.Offset(0, 3).Value, _
rg.Offset(0, 4).Value, _
rg.Offset(0, 5).Value, _
rg.Offset(0, 6).Value, _
rg.Offset(0, 7).Value
'Move down to next row
Set rg = rg.Offset(1, 0)
Loop
Set rg = Nothing
Close lOutputFile
End Sub
Sub InputExample()
Dim lInputFile As Long
Dim rg As Range
'variant variables for reading
'from text file
Dim v1, v2, v3, v4
Dim v5, v6, v7, v8
'set rg to refer to upper-left cell of range
Set rg = ThisWorkbook.Worksheets(2).Range("a1")
'clear any existing data
rg.CurrentRegion.ClearContents
'Get a valid file number
lInputFile = FreeFile
'create a new file for input
Open "C:\Input Example.txt" For Input As #lInputFile
'loop until you hit the end of file
Do Until EOF(lInputFile)
'Read the data to the file
'have to read into a variable - an't assign
'directly to a range
Input #lInputFile, v1, v2, v3, v4, v5, v6, v7, v8
'Transfer values to that worksheet
rg.Value = v1
rg.Offset(0, 1).Value = v2
rg.Offset(0, 2).Value = v3
rg.Offset(0, 3).Value = v4
rg.Offset(0, 4).Value = v5
rg.Offset(0, 5).Value = v6
rg.Offset(0, 6).Value = v7
rg.Offset(0, 7).Value = v8
'move down to next row
Set rg = rg.Offset(1, 0)
Loop
Set rg = Nothing
Close lInputFile
End Sub
15.6.2.1 用Print创建OLAP查询文件
代码清单15.6: 创建一个OLAP查询文件
代码
'代码清单15.6: 创建一个OLAP查询文件
Sub CreateQQY()
Dim lFileNumber As Long
Dim sText As String
Dim oSettings As New Settings
Dim sFileName As String
On Error GoTo ErrHandler
'Obtain a file number to use
lFileNumber = FreeFile
'Determine the file name and folder location.
sFileName = QueriesPath & oSettings.Item("OQYName").Value & ".oqy"
'Open the file. note - this overwrites any existing file
'with the same name in the same folder
Open sFileName For Output As #lFileNumber
'Output the OQY details
Print #lFileNumber, "QueryType=OLEDB"
Print #lFileNumber, "Version=1"
Print #lFileNumber, "CommandType=Cube"
Print #lFileNumber, "Connection=Provider=MSOLAP.2;" & _
"Data Source=" & oSettings.Item("Database").Value & ";" & _
"Initial Catalog=" & osetting.Item("database").Value & _
"; client cach size = 25; auto synch period=10000"
Print #lFileNumber, "CommandText=" & oSettings.Item("Cube").Value
'close the file
Close lFileNumber
Set oSettings = Nothing
MsgBox "your olap connection has been created. ", vbOKOnly
Exit Sub
ErrHandler:
MsgBox "An error occured while creating your olap connection. " & Err.Description, vbOKOnly
End Sub
'the file sould be stored in the queries folder associated with
'the current user. for example, assuming user name = Administrator,
'the OQY file should be store in:
'C:\Documents and Settings\Administrator\Application Data\Microsoft\Queries
Function QueriesPath() As String
Dim sLibraryPath As String
'Get the AddIns path associated with the current user
sLibraryPath = Application.UserLibraryPath
'The Queries path is a peer of AddIns
QueriesPath = Replace(sLibraryPath, "\Microsoft\AddIns\", "\Microsoft\Queries\")
End Function
Sub CreateQQY()
Dim lFileNumber As Long
Dim sText As String
Dim oSettings As New Settings
Dim sFileName As String
On Error GoTo ErrHandler
'Obtain a file number to use
lFileNumber = FreeFile
'Determine the file name and folder location.
sFileName = QueriesPath & oSettings.Item("OQYName").Value & ".oqy"
'Open the file. note - this overwrites any existing file
'with the same name in the same folder
Open sFileName For Output As #lFileNumber
'Output the OQY details
Print #lFileNumber, "QueryType=OLEDB"
Print #lFileNumber, "Version=1"
Print #lFileNumber, "CommandType=Cube"
Print #lFileNumber, "Connection=Provider=MSOLAP.2;" & _
"Data Source=" & oSettings.Item("Database").Value & ";" & _
"Initial Catalog=" & osetting.Item("database").Value & _
"; client cach size = 25; auto synch period=10000"
Print #lFileNumber, "CommandText=" & oSettings.Item("Cube").Value
'close the file
Close lFileNumber
Set oSettings = Nothing
MsgBox "your olap connection has been created. ", vbOKOnly
Exit Sub
ErrHandler:
MsgBox "An error occured while creating your olap connection. " & Err.Description, vbOKOnly
End Sub
'the file sould be stored in the queries folder associated with
'the current user. for example, assuming user name = Administrator,
'the OQY file should be store in:
'C:\Documents and Settings\Administrator\Application Data\Microsoft\Queries
Function QueriesPath() As String
Dim sLibraryPath As String
'Get the AddIns path associated with the current user
sLibraryPath = Application.UserLibraryPath
'The Queries path is a peer of AddIns
QueriesPath = Replace(sLibraryPath, "\Microsoft\AddIns\", "\Microsoft\Queries\")
End Function
15.7 字符串函数的功能
代码清单15.7: 一个使用字符串函数的例子
代码
'代码清单15.7: 一个使用字符串函数的例子
Sub UsefulStringFunctions()
Dim sTestWord As String
sTestWord = "filename"
'Len demonstration
Debug.Print sTestWord & " is " & Len(sTestWord) & " characters long."
'Mid & concatenation demonstration
Debug.Print Mid(sTestWord, 3, 1) & Right(sTestWord, 3)
'Left demonstration
Debug.Print Left(sTestWord, 4)
'Right demonstration
Debug.Print Right(sTestWord, 4)
'Trim demonstration
sTestWord = " padded "
Debug.Print ">" & sTestWord & "<"
Debug.Print ">" & LTrim(sTestWord) & "<"
Debug.Print ">" & RTrim(sTestWord) & "<"
Debug.Print ">" & Trim(sTestWord) & "<"
'StrConv demonstration
sTestWord = "the moon over minneapolis is big and bright."
Debug.Print StrConv(sTestWord, vbLowerCase)
Debug.Print StrConv(sTestWord, vbUpperCase)
Debug.Print StrConv(sTestWord, vbProperCase)
'split demonstration
sTestWord = "one, two, three, 4, five, six"
DemoSplit sTestWord
End Sub
Sub DemoSplit(sCSV As String)
Dim vaValues As Variant
Dim nIndex As Integer
'Split the values
vaValues = Split(sCSV, ",")
'Loop through the values
For nIndex = 0 To UBound(vaValues)
Debug.Print "item (" & nIndex & ") is " & vaValues(nIndex)
Next
End Sub
Sub UsefulStringFunctions()
Dim sTestWord As String
sTestWord = "filename"
'Len demonstration
Debug.Print sTestWord & " is " & Len(sTestWord) & " characters long."
'Mid & concatenation demonstration
Debug.Print Mid(sTestWord, 3, 1) & Right(sTestWord, 3)
'Left demonstration
Debug.Print Left(sTestWord, 4)
'Right demonstration
Debug.Print Right(sTestWord, 4)
'Trim demonstration
sTestWord = " padded "
Debug.Print ">" & sTestWord & "<"
Debug.Print ">" & LTrim(sTestWord) & "<"
Debug.Print ">" & RTrim(sTestWord) & "<"
Debug.Print ">" & Trim(sTestWord) & "<"
'StrConv demonstration
sTestWord = "the moon over minneapolis is big and bright."
Debug.Print StrConv(sTestWord, vbLowerCase)
Debug.Print StrConv(sTestWord, vbUpperCase)
Debug.Print StrConv(sTestWord, vbProperCase)
'split demonstration
sTestWord = "one, two, three, 4, five, six"
DemoSplit sTestWord
End Sub
Sub DemoSplit(sCSV As String)
Dim vaValues As Variant
Dim nIndex As Integer
'Split the values
vaValues = Split(sCSV, ",")
'Loop through the values
For nIndex = 0 To UBound(vaValues)
Debug.Print "item (" & nIndex & ") is " & vaValues(nIndex)
Next
End Sub
