1 Imports System.IO
2 Imports Microsoft.Office.Interop
3
4 Public Class Form1
5
6 Dim errflg As Boolean = False
7 Dim MainDT As DataTable
8
9
10 Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
11 Call ResetAll()
12 Me.RadioButton1.Checked = True
13 End Sub
14
15 Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
16 Dim opfile As New OpenFileDialog \'声名新open 窗口
17 Dim filetmp() As String \'存文件名
18 \' opfile.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*" \'添加过滤文件
19 opfile.Filter = "文本文件(*.txt)|*.txt" \'添加过滤文件
20 opfile.Multiselect = True \'多开文件打开
21 If opfile.ShowDialog = Windows.Forms.DialogResult.OK Then \'如果打开窗口OK
22 If opfile.FileName <> "" Then \'如果有选中文件
23 ReDim filetmp(opfile.SafeFileNames.Length)
24 filetmp = opfile.SafeFileNames \'取文件名
25 Me.TextBox1.Text = opfile.FileName
26 Me.TextBox1.Enabled = False
27
28 End If
29 End If
30 End Sub
31
32 Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles btnReset.Click
33 Call ResetAll()
34
35 End Sub
36
37 Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
38 If CheckCondition() Then
39
40 Call ImportData()
41 Call EditData()
42 If Me.RadioButton1.Checked Then
43
44 \'获取路径
45 Dim fi As FileInfo = New FileInfo(Me.TextBox1.Text.Trim)
46 Dim filepath As String = fi.DirectoryName & "\"
47 Dim exportName As String = filepath & Me.TextBox2.Text & "\" & Me.TextBox2.Text & ".xlsx"
48
49 If MainDT.Rows.Count > 0 Then
50 \'如果有数据，创建文件夹
51 Directory.CreateDirectory(filepath & Me.TextBox2.Text)
52 Call ExportToExcel(MainDT, exportName, Me.TextBox2.Text & ".xlsx")
53 Else
54 MessageBox.Show("目标文件无数据", "", MessageBoxButtons.OK, MessageBoxIcon.Warning)
55 End If
56 Else
57 Call EditMultData()
58 End If
59
60 Call ResetAll()
61 MainDT.Clear()
62
63 End If
64 End Sub
65
66 Private Sub TextBox2_KeyPress(sender As System.Object, e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox2.KeyPress
67 If Asc(e.KeyChar) <> 8 Then
68 If e.KeyChar < "0" Or e.KeyChar > "9" Then
69 e.Handled = True
70 End If
71 End If
72
73 End Sub
74
75 Private Sub EditData()
76
77 For i = MainDT.Rows.Count - 1 To 0 Step -1
78 If MainDT.Rows(i)("QQFrom").ToString <> Me.TextBox2.Text And MainDT.Rows(i)("QQTo").ToString <> Me.TextBox2.Text Then
79 MainDT.Rows.RemoveAt(i)
80 End If
81 Next
82
83
84
85
86
87
88 End Sub
89
90 Private Sub EditMultData()
91 Dim SelectDt As DataTable = MainDT.Copy
92
93 Dim i As Integer
94 Dim j As Integer
95 Dim n As Integer
96 Dim m As Integer
97 Dim VqqFrom As String
98 Dim VqqTo As String
99 Dim strExpr As String
100
101 \'合并所有的QQ号码 QQFrom + QQTo
102 If MainDT.Rows.Count > 0 Then
103 For i = 0 To MainDT.Rows.Count - 1
104 Dim dr As DataRow = SelectDt.NewRow
105 dr("QQFrom") = MainDT.Rows(i)("QQTo")
106 SelectDt.Rows.Add(dr)
107 Next
108 End If
109
110 \'去重复所有QQ号码
111 SelectDt = SelectDt.DefaultView.ToTable(True, "QQFrom")
112
113 \'去除目标QQ号码
114 For j = SelectDt.Rows.Count - 1 To 0 Step -1
115 If SelectDt.Rows(j)("QQFrom").ToString = Me.TextBox2.Text Then
116 SelectDt.Rows.RemoveAt(j)
117 End If
118 Next
119
120 \'循环出Excel文件
121 For n = 0 To SelectDt.Rows.Count - 1
122 \'筛选
123 Dim ExportDt As DataTable = MainDT.Copy
124
125 For m = ExportDt.Rows.Count - 1 To 0 Step -1
126 VqqFrom = Me.TextBox2.Text
127 VqqTo = SelectDt.Rows(n)(0).ToString()
128 strExpr = "QQFrom=" & VqqFrom & " and QQto=" & VqqTo & " or " & "QQFrom=" & VqqTo & " and QQto=" & VqqFrom
129 ExportDt.DefaultView.RowFilter = strExpr
130 ExportDt = ExportDt.DefaultView.ToTable()
131 ExportDt.DefaultView.Sort = "Time"
132
133 VqqFrom = String.Empty
134 VqqTo = String.Empty
135 strExpr = String.Empty
136 Next
137
138 \'获取路径
139 Dim fi As FileInfo = New FileInfo(Me.TextBox1.Text.Trim)
140 Dim filepath As String = fi.DirectoryName & "\"
141 Dim foldName As String = Me.TextBox2.Text & "-" & SelectDt.Rows(n)(0).ToString()
142 Dim exportName As String = filepath & foldName & "\" & foldName & ".xlsx"
143
144 If MainDT.Rows.Count > 0 Then
145 \'如果有数据，创建文件夹
146 Directory.CreateDirectory(filepath & foldName)
147 Call ExportToExcel(ExportDt, exportName, foldName & ".xlsx")
148 Else
149 MessageBox.Show("目标文件无数据", "", MessageBoxButtons.OK, MessageBoxIcon.Warning)
150 End If
151 Next
152
153 MessageBox.Show("全部文件已经生成", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
154
155 End Sub
156
157 Private Sub ExportToExcel(ByVal dtOut As DataTable, ByVal exportName As String, ByVal fileName As String)
158 Try
159 Dim xlsApp As Excel.Application
160 Dim xlsBook As Excel.Workbook
161 Dim xlsSheet As Excel.Worksheet
162 xlsApp = New Excel.Application()
163 xlsBook = xlsApp.Workbooks.Add
164 xlsSheet = xlsBook.Worksheets(1)
165 xlsApp.Visible = False
166
167 Dim rowNum As Int32 = dtOut.Rows.Count
168 Dim columnNum As Int32 = dtOut.Columns.Count
169 Dim rowIndex As Int32 = 0
170 Dim columnIndex As Int32 = 0
171 Dim i As Int16 = 0
172 Dim j As Int16 = 0
173
174 \'将DataTable中的数据导入Excel中
175 For i = 0 To rowNum - 1
176 rowIndex = rowIndex + 1
177 columnIndex = 0
178 For j = 0 To columnNum - 1
179 columnIndex = columnIndex + 1
180 xlsApp.Cells(rowIndex, columnIndex) = dtOut.Rows(i)(j)
181 Next
182 Next
183
184 xlsBook.SaveAs(exportName)
185 xlsSheet = Nothing
186 xlsBook = Nothing
187 xlsApp.Quit()
188 MessageBox.Show(fileName & "文件已经生成", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
189 Catch ex As Exception
190 MessageBox.Show(fileName & "文件生成失败", "", MessageBoxButtons.OK, MessageBoxIcon.Warning)
191 End Try
192 End Sub
193
194 Private Sub ImportData()
195
196 MainDT = New DataTable("QQRecord")
197 Dim dc1 As DataColumn = New DataColumn("QQFrom", Type.GetType("System.String"))
198 Dim dc2 As DataColumn = New DataColumn("QQFromName", Type.GetType("System.String"))
199 Dim dc3 As DataColumn = New DataColumn("QQFromIP", Type.GetType("System.String"))
200 Dim dc4 As DataColumn = New DataColumn("QQTo", Type.GetType("System.String"))
201 Dim dc5 As DataColumn = New DataColumn("QQToName", Type.GetType("System.String"))
202 Dim dc6 As DataColumn = New DataColumn("QQToIP", Type.GetType("System.String"))
203 Dim dc7 As DataColumn = New DataColumn("Time", Type.GetType("System.String"))
204 Dim dc8 As DataColumn = New DataColumn("Detail", Type.GetType("System.String"))
205 MainDT.Columns.Add(dc1)
206 MainDT.Columns.Add(dc2)
207 MainDT.Columns.Add(dc3)
208 MainDT.Columns.Add(dc4)
209 MainDT.Columns.Add(dc5)
210 MainDT.Columns.Add(dc6)
211 MainDT.Columns.Add(dc7)
212 MainDT.Columns.Add(dc8)
213
214 Dim fs As System.IO.FileStream
215 Dim sr As System.IO.StreamReader
216 Dim strLine As String
217 fs = New System.IO.FileStream(Me.TextBox1.Text.Trim, IO.FileMode.OpenOrCreate)
218 sr = New System.IO.StreamReader(fs, System.Text.Encoding.Default)
219
220 Do
221 strLine = sr.ReadLine
222 If Not strLine Is Nothing Then
223 Dim strCells As String() = Split(strLine, ",")
224 MainDT.Rows.Add(strCells)
225 End If
226
227 Loop Until strLine Is Nothing
228
229 MainDT.DefaultView.Sort = "Time"
230 MainDT = MainDT.DefaultView.ToTable()
231
232 sr.Close()
233 fs.Close()
234
235 End Sub
236 Private Function CheckCondition() As Boolean
237
238 If checkExt() = False Then
239 MessageBox.Show("请选择正确的文件", "", MessageBoxButtons.OK, MessageBoxIcon.Warning)
240 Return False
241 End If
242
243 If Me.TextBox2.Text.Trim() = String.Empty Then
244 MessageBox.Show("请填写目标QQ号码", "", MessageBoxButtons.OK, MessageBoxIcon.Warning)
245 Return False
246 End If
247
248 Return True
249 End Function
250
251 Private Sub ResetAll()
252 Me.TextBox1.Text = String.Empty
253 Me.TextBox2.Text = String.Empty
254 Me.TextBox1.Enabled = True
255 Me.TextBox2.Enabled = True
256 End Sub
257
258 Private Function checkExt() As Boolean
259
260 Dim path As String = Me.TextBox1.Text.Trim()
261 Dim ext As String = System.IO.Path.GetExtension(path)
262
263 If ext <> ".txt" Then
264 Return False
265 End If
266
267 Return True
268 End Function
269
270
271 End Class