第15章 在解决方案中并入文本文件

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

 

代码清单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

 

 

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

 

 

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

 

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

 

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

 

 

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

 

 

转载于:https://www.cnblogs.com/csl-office-vb-sql-net/archive/2010/01/21/1653246.html