第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( "O QYName " ).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,  "C ommandText= "   &  oSettings.Item( "C ube " ).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