VB6做了个简单的ListView内容导出函数

Private Type LV_ITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    state As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
   
Private Const LVIF_TEXT As Long = &H1
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)

 

Public Function ExportListViewContent(ByVal objListView As ListView, ByVal strFilePath As String) As Boolean
    On Error GoTo hErr
    If objListView.ListItems.Count = 0 Then
       ExportListViewContent = False
       Exit Function
    End If
    Dim objItem As LV_ITEM
    Dim intFileNumber As Integer
    Dim lngIndex As Long
    Dim lngSubItem As Long
    Dim strItemText As String
    Dim strItemBuffer As String
    Dim lngRet As Long
    intFileNumber = FreeFile
    Open strFilePath For Output As #intFileNumber
        For lngIndex = 0 To objListView.ListItems.Count - 1
            strItemText = ""
            For lngSubItem = 0 To objListView.ColumnHeaders.Count - 1
                With objItem
                     .mask = LVIF_TEXT
                     .iSubItem = lngSubItem
                     .pszText = Space$(1024)
                     .cchTextMax = Len(.pszText)
                End With
                lngRet = SendMessage(objListView.hWnd, LVM_GETITEMTEXT, lngIndex, objItem)
                strItemBuffer = Left$(objItem.pszText, lngRet)
                If lngSubItem = 0 Then
                   strItemBuffer = SetStringFixedLength(Left$(objItem.pszText, lngRet), 8)
                Else
                   strItemBuffer = Left$(objItem.pszText, lngRet)
                End If
               
                If lngSubItem < objListView.ColumnHeaders.Count - 1 Then
                   strItemText = strItemText & strItemBuffer & "   "
                Else
                   strItemText = strItemText & strItemBuffer
                End If
            Next lngSubItem
            Print #intFileNumber, strItemText
        Next lngIndex
    If intFileNumber > 0 Then Close #intFileNumber
    ExportListViewContent = True
    Exit Function
hErr:
    If intFileNumber > 0 Then Close #intFileNumber
End Function

 

Function SetStringFixedLength(ByVal strIn As String, ByVal lngFixStrLen As Long) As String
    On Error Resume Next
    Dim strBuf As String
    Dim lngBufLen As Long
    strBuf = Trim(strIn)
    lngBufLen = LenB(StrConv(strBuf, vbFromUnicode))
    If lngBufLen > 0 And lngFixStrLen > 0 Then
       If lngFixStrLen - lngBufLen > 0 Then
          SetStringFixedLength = strBuf & Space(lngFixStrLen - lngBufLen)
       Else
          SetStringFixedLength = strBuf
       End If
    Else
       SetStringFixedLength = strBuf
    End If
End Function

'==================================
我的一个调用示例：

Private Sub Command1_Click()
    If ExportListViewContent(ListView1, App.Path & "/历史盈亏.txt") = True Then
       MsgBox "导出成功", vbInformation, "提示"
    End If
End Sub