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 IfEnd Sub (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|