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

mac2022-06-30  86

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 LongEnd 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 = &H1Private Const LVM_FIRST As Long = &H1000Private 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 FunctionhErr:    If intFileNumber > 0 Then Close #intFileNumberEnd 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 IfEnd Function

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

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

 

转载于:https://www.cnblogs.com/forads/archive/2009/06/14/2161170.html

相关资源:VB listview导出数据到EXCEL
最新回复(0)