Skip to content

Commit e5b857c

Browse files
pavlexanderpavlexander
committed
initial version
1 parent 10e7e25 commit e5b857c

File tree

3 files changed

+265
-0
lines changed

3 files changed

+265
-0
lines changed

‎Module1.bas‎

Lines changed: 263 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,263 @@
1+
Attribute VB_Name = "Module1"
2+
Sub generateFile()
3+
4+
Dim ws As Worksheet
5+
Dim ws_main As Worksheet: Set ws_main = ActiveWorkbook.Worksheets("main")
6+
Dim WS_Count As Integer
7+
Dim I As Integer
8+
Dim Column_count As String
9+
Dim Row_Count As String
10+
Dim insertValues As String
11+
Dim separator As String: separator = ","
12+
Dim cellValue As String
13+
Dim tableName As String
14+
Dim insertCommand As String
15+
16+
Dim OutputFileNum As Integer
17+
Dim PathName As String
18+
19+
Dim FileName As String
20+
Dim FileExtension As String
21+
Dim useStatement As String
22+
Dim TablesTotal As Integer
23+
Dim InsertsTotal As Integer
24+
25+
26+
ws_main.Range("TBL_TOT").Value = ""
27+
ws_main.Range("INS_TOT").Value = ""
28+
29+
FileName = ws_main.Range("FILE_NAME") 'Cells(2, 5)
30+
FileExtension = ws_main.Range("FILE_EXT") 'Cells(3, 5)
31+
useStatement = ws_main.Range("USE_SQL") 'Cells(4, 5)
32+
33+
WS_Count = ActiveWorkbook.Worksheets.Count
34+
35+
TablesTotal = WS_Count - 1
36+
37+
If WS_Count > 1 Then
38+
39+
PathName = Application.ActiveWorkbook.Path
40+
OutputFileNum = FreeFile
41+
42+
Open PathName & "\" & FileName & "." & FileExtension For Output Lock Write As #OutputFileNum
43+
44+
For I = 2 To WS_Count
45+
' MsgBox ActiveWorkbook.Worksheets(I).Name
46+
Set ws = ActiveWorkbook.Worksheets(I)
47+
48+
If ws.Name <> "main" Then
49+
tableName = ws.Name
50+
'MsgBox tableName
51+
52+
Column_count = ws.UsedRange.Columns.Count
53+
Row_Count = ws.UsedRange.Rows.Count
54+
55+
If Row_Count > 3 And Column_count > 1 Then
56+
57+
'MsgBox Column_count
58+
'MsgBox Row_Count
59+
60+
For row = 4 To Row_Count
61+
insertValues = ""
62+
63+
For col = 1 To Column_count
64+
'MsgBox ws.Cells(row, col).Value
65+
66+
If ws.Cells(row, col) = "" Then
67+
If ws.Cells(2, col) = "" Then
68+
Exit For
69+
ElseIf ws.Cells(2, col) = "DEFAULT" Then
70+
cellValue = "DEFAULT"
71+
72+
insertValues = insertValues & (separator & cellValue)
73+
ElseIf ws.Cells(2, col) = "NULL" Then
74+
cellValue = ""
75+
76+
insertValues = insertValues & (separator & cellValue)
77+
Else
78+
cellValue = ws.Cells(2, col).Value
79+
80+
insertValues = insertValues & (separator & cellValue)
81+
End If
82+
Else
83+
If ws.Cells(1, col) <> "" Then
84+
If ws.Cells(1, col) = "NUMBER" Then
85+
cellValue = ws.Cells(row, col).Value
86+
End If
87+
Else
88+
cellValue = "'" & ws.Cells(row, col).Value & "'"
89+
cellValue = Replace(cellValue, """", "\""")
90+
End If
91+
92+
insertValues = insertValues & (separator & cellValue)
93+
End If
94+
Next col
95+
96+
If Len(insertValues) <> 0 Then
97+
insertValues = Right$(insertValues, (Len(insertValues) - Len(separator)))
98+
End If
99+
100+
InsertsTotal = InsertsTotal + 1
101+
102+
'MsgBox insertValues
103+
If useStatement = "Yes" Then
104+
insertCommand = "INSERT INTO {tableName} VALUES ({insertValues});"
105+
insertCommand = Replace(insertCommand, "{tableName}", tableName)
106+
insertCommand = Replace(insertCommand, "{insertValues}", insertValues)
107+
Print #OutputFileNum, insertCommand
108+
Else
109+
Print #OutputFileNum, insertValues
110+
End If
111+
112+
Next row
113+
End If
114+
End If
115+
Next I
116+
117+
Close OutputFileNum
118+
119+
End If
120+
121+
ws_main.Range("TBL_TOT").Value = TablesTotal
122+
ws_main.Range("INS_TOT").Value = InsertsTotal
123+
124+
End Sub
125+
126+
Sub AddWSTable()
127+
128+
Dim ws As Worksheet
129+
Dim ws_main As Worksheet: Set ws_main = ActiveWorkbook.Worksheets("main")
130+
Dim insertLine As String
131+
Dim openPos As Integer
132+
Dim closePos As Integer
133+
Dim midBit As String
134+
Dim WrdArray() As String
135+
Dim headerCellValue As String
136+
137+
Dim matchesFound As Collection
138+
Dim tableName As String
139+
140+
insertLine = ws_main.Range("INS_STMT").Value '14, 4
141+
142+
If insertLine <> "" Then
143+
Set matchesFound = getSeparatedValues(insertLine, "`")
144+
'MsgBox matchesFound.Count
145+
'MsgBox matchesFound(1)
146+
tableName = matchesFound(2)
147+
148+
If SheetExists(tableName) = True Then
149+
MsgBox "Error. Worksheet (table) with name '" & tableName & "' already exists."
150+
Else
151+
openPos = InStr(insertLine, "(")
152+
closePos = InStr(insertLine, ")")
153+
midBit = Mid(insertLine, openPos + 1, closePos - openPos - 1)
154+
155+
'MsgBox midBit
156+
157+
WrdArray() = Split(midBit, ",")
158+
159+
If UBound(WrdArray) > 0 Then
160+
Set ws = ThisWorkbook.Sheets.Add(After:= _
161+
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
162+
ws.Name = tableName
163+
164+
For I = LBound(WrdArray) To UBound(WrdArray)
165+
headerCellValue = WrdArray(I)
166+
headerCellValue = Trim(headerCellValue)
167+
headerCellValue = Replace(headerCellValue, "`", "")
168+
ws.Cells(3, I + 1).Value = headerCellValue
169+
170+
If headerCellValue = "id" Then
171+
ws.Cells(1, I + 1).Value = "NUMBER"
172+
ElseIf EndsWith(headerCellValue, "_by") Then
173+
ws.Cells(1, I + 1).Value = "NUMBER"
174+
ElseIf EndsWith(headerCellValue, "_id") Then
175+
ws.Cells(1, I + 1).Value = "NUMBER"
176+
End If
177+
178+
ws.Cells(1, I + 1).EntireColumn.AutoFit
179+
ws.Cells(1, I + 1).EntireColumn.HorizontalAlignment = xlCenter
180+
Next I
181+
182+
ws.Cells(1, 1).EntireRow.Interior.Color = ws_main.Range("COLOR1").Interior.Color '16, 4
183+
ws.Cells(2, 1).EntireRow.Interior.Color = ws_main.Range("COLOR2").Interior.Color '17, 4
184+
ws.Cells(3, 1).EntireRow.Interior.Color = ws_main.Range("COLOR3").Interior.Color '18, 4
185+
End If
186+
End If
187+
End If
188+
189+
End Sub
190+
191+
Private Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
192+
Dim sht As Worksheet
193+
194+
If wb Is Nothing Then Set wb = ThisWorkbook
195+
On Error Resume Next
196+
Set sht = wb.Sheets(shtName)
197+
On Error GoTo 0
198+
SheetExists = Not sht Is Nothing
199+
End Function
200+
201+
Private Function getSeparatedValues(sText As String, char As String) As Collection
202+
Dim getSeparatedValues_ As New Collection
203+
204+
Dim bIsBetween As Boolean
205+
Dim skipNext As Boolean
206+
207+
Dim iLength As Integer
208+
209+
Dim sToken As String
210+
211+
bIsBetween = False
212+
skipNext = False
213+
214+
sToken = ""
215+
216+
iLength = Len(sText) - 1
217+
218+
For I = 1 To iLength
219+
If (skipNext = True) Then
220+
skipNext = False
221+
Else
222+
Dim chr As String
223+
Dim nextChr As String
224+
225+
chr = Mid(sText, I, 1)
226+
nextChr = Mid(sText, I + 1, 1)
227+
228+
If (chr = char) Then
229+
bIsBetween = True
230+
End If
231+
232+
If (nextChr = char) Then
233+
bIsBetween = False
234+
End If
235+
236+
If (bIsBetween = True) Then
237+
sToken = sToken & nextChr
238+
Else
239+
If (Len(sToken) > 0) Then
240+
skipNext = True
241+
getSeparatedValues_.Add (sToken)
242+
sToken = ""
243+
End If
244+
End If
245+
End If
246+
Next I
247+
248+
Set getSeparatedValues = getSeparatedValues_
249+
Set getSeparatedValues_ = Nothing
250+
End Function
251+
252+
Private Function EndsWith(str As String, ending As String) As Boolean
253+
Dim endingLen As Integer
254+
endingLen = Len(ending)
255+
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
256+
End Function
257+
258+
Private Function StartsWith(str As String, start As String) As Boolean
259+
Dim startLen As Integer
260+
startLen = Len(start)
261+
StartsWith = (Left(Trim(UCase(str)), startLen) = UCase(start))
262+
End Function
263+

‎mysql_data_admin.xlsm‎

35.7 KB
Binary file not shown.

‎test001.txt‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
INSERT INTO example_table VALUES (1,'{\"en\":\"House\", \"ru\":\"���\"}','testing varchar \"abc\"',1,12,DEFAULT);
2+
INSERT INTO example_table VALUES (2,'{\"en\":\"Moon\", \"ru\":\"����\"}','testing varchar \"abc\"',999,14,DEFAULT);

0 commit comments

Comments
 (0)