VB6做了个简单的ListView内容导出函数
2009-06-14 01:23
330 查看
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 If
End Sub
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 If
End Sub
相关文章推荐
- VB6做了个简单的ListView内容导出函数
- VB6做了个简单的ListView内容导出函数
- Android 关于在ScrollView中加上一个ListView,ListView内容显示不完全(总是显示第一项)的问题的两种简单的解决方案
- 将jsp内容导出为Excel表简单实例
- aix英文版导出excel单元格内容显示不全简单解决方法
- winform中 将listview的数据导出至 excel (最简单的方法)
- LISTVIEW导出到EXCEL的通用函数
- 将ListView中的内容导出到Word和Excel
- 将 DbGrid查询内容的导出为Txt函数——Delphi
- 将ListView中的内容以Excel导出
- VC6.0导出内容到excel的简单代码例子,具体方法没有记录
- 将ListView中的内容导出到Word和Excel(新)
- 常见适配器的用法(在listview中 ,把三个edittext内容放在简单适配器中)
- 将ListView中的内容导出到Word和Excel(新)
- 仿贴吧内容下的简单ListView嵌套GridView
- 简单的内容差异对比函数
- asp.net导出excel和打印指定内容的简单代码
- Js 导出table内容到Excel的简单实例
- vb6如何将MSHFlexGrid控件中的内容导出为Excel
- JS 导出table内容到Exel(简单除暴)