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