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