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 TypePrivate 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
VB6做了个简单的ListView内容导出函数
原创
©著作权归作者所有:来自51CTO博客作者唐古拉山的原创作品,请联系作者获取转载授权,否则将追究法律责任
提问和评论都可以,用心的回复会被更多人看到
评论
发布评论
相关文章
-
VB6的qbcolor函数
QBColor函数返回索引返回一个 Long,用来表示所对应颜色值的 RGB 颜色码。语法QBColor(color
vb timer exe 控件 整型 -
VB6非Banker舍入的Round函数
今天无意撞到一个帖子,发现争论蛮有意思的,依旧是关于 Round 函数:VB6的
git Standard 四舍五入 -
vb6连sqlite
vb6连sqlite: vb6.0操作SQLite数据库 http
sqlite vb 数据库 html f5