將表格內容轉為文字檔(TXT)

X.Z. · 发表于 2012-4-10 23:21

本帖最后由 X.Z. 于 2012-4-11 08:58 编辑

請問如何將上面這樣樣的表格轉為下面這樣的TXT檔輸出呢
謝謝

object gateway {
ip "129.250.50.61";
type ping;
desc "fa-12-0-0.a01.clevoh01.us.ra.nether.net";
contact "admin@example.com";
};

object gateway {
ip "129.250.50.62";
type ping;
desc "fa-12-0-0.a01.clevoh02.us.ra.nether.net";
contact "admin@example.com";
};

主要用於製作
http://puck.nether.net/sysmon/config.html的設定檔
機器數量太多會打到死日後修改也是問題
拜託幫幫忙謝謝!!

X.Z. · 发表于 2012-4-11 08:59

早上好!往頂一下

X.Z. · 发表于 2012-4-11 22:17

晚上好~ 請幫幫忙謝謝!

X.Z. · 发表于 2012-4-12 00:35

初步做出來了
請問要怎麼加入判斷了
依據TYPE的模式傳回不同位置的儲存格
謝謝

Sub Run()
Dim arr, s$, i&, j&, n%
Open ThisWorkbook.Path & "" & "sysmon.txt" For Output As #1
arr = Range("A1").CurrentRegion
For i = 2 To UBound(arr)
Print #1, vbCrLf & vbCrLf
Print #1, "object gateway {"
Print #1, " ip " & arr(i, 2) & ";"
Print #1, " type " & arr(i, 1) & ";"
Print #1, " desc " & arr(i, 3) & ";"
Print #1, " contact " & arr(i, 4) & ";"
Print #1, "};"
Print #1, vbCrLf & vbCrLf
'Close #1
Next
MsgBox "ok"
Close #1
End Sub

复制代码

X.Z. · 发表于 2012-4-12 00:39

joforn 发表于 2012-4-12 00:19
不想写了，感觉有点复杂，估计看的人很少。

我也要看阿
我自己湊好不容易湊出一點點
還需要您的協助阿
謝謝

liucqa · 发表于 2012-4-12 00:17

joforn 发表于 2012-4-12 00:11

大侠，你的类模块之二出来没有呀？

joforn · 发表于 2012-4-12 00:19

liucqa 发表于 2012-4-12 00:17
大侠，你的类模块之二出来没有呀？

不想写了，感觉有点复杂，估计看的人很少。

joforn · 发表于 2012-4-12 00:11

Sub ExportToText()
Const str1 = "object gateway {" & vbCrLf & " ip ""%2"";" & vbCrLf & _
" type %1;" & vbCrLf & " desc ""%3"";" & vbCrLf & _
" contact ""%4"";" & vbCrLf & "};" & vbCrLf
Dim FileName As Variant
Dim I As Long, J As Long, Uincode As Integer
Dim FileL As Long
Dim strTemp As String, strFile As String
On Error Resume Next
FileName = Application.GetSaveAsFilename(vbNullString, "文本文件,*.TXT")
Select Case VarType(FileName)
Case vbBoolean:
MsgBox "操作被取消！"
Case vbString:
If Len(Dir(FileName, vbHidden Or vbNormal Or vbReadOnly Or vbSystem)) Then
Select Case MsgBox("文件已存在，是否复盖当前文件？", vbYesNoCancel)
Case vbYes
SetAttr FileName, vbNormal
Kill FileName
If Len(Dir(FileName, vbHidden Or vbNormal Or vbReadOnly Or vbSystem)) Then
MsgBox "打开文件失败！"
Exit Sub
End If
Case vbNo
Call ExportToText: Exit Sub
Case vbCancel
MsgBox "操作被取消！": Exit Sub
End Select
End If
Uincode = MsgBox("文件使用Uincode编码？", vbYesNo Or vbDefaultButton2) = vbYes
FileL = FreeFile
Open FileName For Binary As FileL
If Uincode Then
J = &HFEFF
Put FileL, , J
End If
With Sheet1
For I = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
strTemp = str1
For J = 1 To 4
strTemp = Replace(strTemp, "%" & J, .Cells(I, J).Text)
Next J
strFile = strFile & strTemp
If I Mod 1000 Then
If Uincode Then strFile = StrConv(strFile, vbUnicode)
Put FileL, , strFile
strFile = vbNullString
End If
Next I
If Len(strFile) Then
If Uincode Then strFile = StrConv(strFile, vbUnicode)
Put FileL, , strFile
End If
End With
Close FileL
End Select
End Sub

复制代码

X.Z. · 发表于 2012-4-12 13:34

自己湊出方法了
雖然很遜
但是湊合著用
雖然這東西沒什麼人
有路過可以幫我修改一下也是感謝啦

Sub Run()
Dim arr, s$, i&, j&, n%
Open ThisWorkbook.Path & "" & "sysmon.txt" For Output As #1
arr = Range("A1").CurrentRegion
For i = 2 To UBound(arr)
'MsgBox arr(i, 3)
If arr(i, 3) = "ping" Then
Print #1, vbCrLf & vbCrLf
Print #1, "object " & arr(i, 1) & " {"
Print #1, " ip " & """" & arr(i, 2) & """" & ";"
Print #1, " type " & arr(i, 3) & ";"
Print #1, " desc " & """" & arr(i, 4) & """" & ";"
Print #1, " dep " & """" & arr(i, 5) & """" & ";"
Print #1, " contact " & """" & arr(i, 6) & """" & ";"
Print #1, " contact_on " & arr(i, 7) & ";"
Print #1, "};"
Print #1, vbCrLf & vbCrLf
'Close #1
Else
If arr(i, 3) = "port" Then
Print #1, vbCrLf & vbCrLf
Print #1, "object " & arr(i, 1) & " {"
Print #1, " ip " & """" & arr(i, 2) & """" & ";"
Print #1, " type " & arr(i, 3) & ";"
Print #1, " desc " & """" & arr(i, 4) & """" & ";"
Print #1, " port " & """" & arr(i, 8) & """" & ";"
Print #1, " contact " & """" & arr(i, 6) & """" & ";"
Print #1, " contact_on " & arr(i, 7) & ";"
Print #1, "};"
Print #1, vbCrLf & vbCrLf
Else
If arr(i, 3) = "www" Then
Print #1, vbCrLf & vbCrLf
Print #1, "object " & arr(i, 1) & " {"
Print #1, " ip " & """" & arr(i, 2) & """" & ";"
Print #1, " type " & arr(i, 3) & ";"
Print #1, " url " & """" & arr(i, 9) & """" & ";"
Print #1, " urltext " & """" & arr(i, 10) & """" & ";"
Print #1, " desc " & """" & arr(i, 4) & """" & ";"
Print #1, " contact " & """" & arr(i, 6) & """" & ";"
Print #1, " contact_on " & arr(i, 7) & ";"
Print #1, "};"
Print #1, vbCrLf & vbCrLf
Else
End If
End If
End If
Next
MsgBox "ok"
Close #1
End Sub

复制代码

wj2368 · 发表于 2012-4-12 15:01

...................

		自动登录	找回密码
密码			免费注册

[求助] 將表格內容轉為文字檔(TXT)

点评