Extract Data from Excel to Text File

[Alex T]

Hi Mrnacar.

Sorry for asking you a question that is not related to this thread, but i was not able to find any answers. Based upon your knowledge, maybe you can point me to the right direction.

I have a VBA scrip that extracts some values from the Excel File and puts these values in the txt file. This code works great as long as i specify the file name and Output name. I am trying to automate it as much as possible, due to the large number of *.xls files in the specific folder that i need to run it against.

Is there a way to run this VB Script that will executes ALL excel files in that specified folder and will create 1 txt file per each Excel file using that excel file's name, only with the txt ext?

Here is my code:


====================================

Const PARTY_ID = 3
Const ADDR_ID = 4
Const ORG_ID = 1
Const ORG_NAME = 2
Const FIRST_NAME = 5
Const LAST_NAME = 6
Const ADDR_NAME = 7
Const STREET = 8
Const CITY = 9
Const STATE = 10
Const ZIP = 11
Const LATITUDE = 12
Const LONGITUDE = 13

Dim m_sAddressesFolderPath As String
Dim m_sAddressesFile As String
Dim m_sSQL As String

[B][COLOR="Red"]Sub Initialize()
m_sAddressesFolderPath = "C:\Test\" 'Folder where .xls spreadsheet lives.
m_sAddressesFile = "File_name.xls" 'Name of the excel spreadsheet
m_sSQL = "output.txt" 'TXT output file
End Sub[/COLOR][/B]



Sub exportToSQL()

Dim wbkAdresses As Workbook
Dim shtData As Worksheet
Dim rows As Integer
Dim iRow As Integer
Dim sPARTY_ID As String
Dim sADDR_ID As String
Dim sORG_ID As String
Dim sORG_NAME As String
Dim sFIRST_NAME As String
Dim sLAST_NAME As String
Dim sADDR_NAME As String
Dim sSTREET As String
Dim sCITY As String
Dim sSTATE As String
Dim sZIP As String
Dim sLATITUDE As String
Dim sLONGITUDE As String
Dim sLine As String

Dim oFSO As Object
Dim oTextStream As Object

Initialize
Set wbkAdresses = Workbooks.Open(m_sAddressesFolderPath & m_sAddressesFile)
Set shtData = wbkAdresses.Worksheets(1)
rows = shtData.Range(shtData.Range("A1"), shtData.Range("A65535").End(xlUp)).Count

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextStream = oFSO.CreateTextFile(m_sAddressesFolderPath & m_sSQL, True)

For iRow = 2 To rows
sPARTY_ID = Trim(shtData.Cells(iRow, PARTY_ID).Text)
sADDR_ID = Trim(shtData.Cells(iRow, ADDR_ID).Text)
sORG_ID = Trim(shtData.Cells(iRow, ORG_ID).Text)
sORG_NAME = Trim(shtData.Cells(iRow, ORG_NAME).Text)
sFIRST_NAME = Trim(shtData.Cells(iRow, FIRST_NAME).Text)
sLAST_NAME = Trim(shtData.Cells(iRow, LAST_NAME).Text)
sADDR_NAME = Trim(shtData.Cells(iRow, ADDR_NAME).Text)
sSTREET = Trim(shtData.Cells(iRow, STREET).Text)
sCITY = Trim(shtData.Cells(iRow, CITY).Text)
sSTATE = Trim(shtData.Cells(iRow, STATE).Text)
sZIP = Trim(shtData.Cells(iRow, ZIP).Text)
sLATITUDE = Trim(shtData.Cells(iRow, LATITUDE).Text)
sLONGITUDE = Trim(shtData.Cells(iRow, LONGITUDE).Text)


'If IsEmpty(Range("L1").Select) = False And IsEmpty(Range("L1").Select) = False Then
If Len(sLATITUDE) > 0 And Len(sLONGITUDE) > 0 Then

sLine = "update nns.gis_address a set a.location=SDO_GEOMETRY(2001, 8307,SDO_POINT_TYPE(" & sLONGITUDE & ", " & sLATITUDE & ",null),null,null), a.geocode_flag='1' where addr_id=" & sADDR_ID & " and party_id=" & sPARTY_ID & " and geocode_flag='0';"
oTextStream.WriteLine sLine

End If

Next
oTextStream.Close
'wbkAdresses.Close False

End Sub

==============================================

Any help would be greatly appreciated.

Thank you very much.

 

[Peter_SSs]

Re: How to copy multiple rows, where cells have specific value.

Since this is a completely different topic, you really should ask it in a new thread. Many possible helpers will notice that this thread has already had many replies, so they won't even look at it.

BTW, did you try my suggestion for the previous problem?

 

[mrnacar]

Re: How to copy multiple rows, where cells have specific value.

Hi Mrnacar.

Sorry for asking you a question that is not related to this thread, but i was not able to find any answers. Based upon your knowledge, maybe you can point me to the right direction.

I have a VBA scrip that extracts some values from the Excel File and puts these values in the txt file. This code works great as long as i specify the file name and Output name. I am trying to automate it as much as possible, due to the large number of *.xls files in the specific folder that i need to run it against.

Is there a way to run this VB Script that will executes ALL excel files in that specified folder and will create 1 txt file per each Excel file using that excel file's name, only with the txt ext?

==============================================

Any help would be greatly appreciated.

Thank you very much.

I'm not so sure if this will work since I have no real data to test it with so please test it first.

Const FOLDER As String = "C:\Test\"
Sub ProcessEachFileInFolder()
On Error GoTo ErrorHandler
Dim fileName As String
  fileName = Dir(FOLDER)
  ' loop through folder
 Do While Len(fileName) > 0
    Call ProcessFile(fileName)
    fileName = Dir ' pick up next filename, if available
 Loop
Shell ("explorer C:\Test"), vbMaximizedFocus
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub
Sub ProcessFile(fileName As String)
Dim currentWkbk As Excel.Workbook
  ' open workbook
 Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
Const PARTY_ID = 3
Const ADDR_ID = 4
Const ORG_ID = 1
Const ORG_NAME = 2
Const FIRST_NAME = 5
Const LAST_NAME = 6
Const ADDR_NAME = 7
Const STREET = 8
Const CITY = 9
Const STATE = 10
Const ZIP = 11
Const LATITUDE = 12
Const LONGITUDE = 13
Dim m_sAddressesFolderPath As String
Dim m_sAddressesFile As String
Dim m_sSQL As String

Dim wbkAdresses As Workbook
Dim shtData As Worksheet
Dim rows As Integer
Dim iRow As Integer
Dim sPARTY_ID As String
Dim sADDR_ID As String
Dim sORG_ID As String
Dim sORG_NAME As String
Dim sFIRST_NAME As String
Dim sLAST_NAME As String
Dim sADDR_NAME As String
Dim sSTREET As String
Dim sCITY As String
Dim sSTATE As String
Dim sZIP As String
Dim sLATITUDE As String
Dim sLONGITUDE As String
Dim sLine As String
Dim oFSO As Object
Dim oTextStream As Object
m_sSQL = fileName & ".txt" 'TXT output file
Set wbkAdresses = currentWkbk
Set shtData = wbkAdresses.Worksheets(1)
rows = shtData.Range(shtData.Range("A1"), shtData.Range("A65535").End(xlUp)).Count
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextStream = oFSO.CreateTextFile(FOLDER & m_sSQL, True)
For iRow = 2 To rows
sPARTY_ID = Trim(shtData.Cells(iRow, PARTY_ID).Text)
sADDR_ID = Trim(shtData.Cells(iRow, ADDR_ID).Text)
sORG_ID = Trim(shtData.Cells(iRow, ORG_ID).Text)
sORG_NAME = Trim(shtData.Cells(iRow, ORG_NAME).Text)
sFIRST_NAME = Trim(shtData.Cells(iRow, FIRST_NAME).Text)
sLAST_NAME = Trim(shtData.Cells(iRow, LAST_NAME).Text)
sADDR_NAME = Trim(shtData.Cells(iRow, ADDR_NAME).Text)
sSTREET = Trim(shtData.Cells(iRow, STREET).Text)
sCITY = Trim(shtData.Cells(iRow, CITY).Text)
sSTATE = Trim(shtData.Cells(iRow, STATE).Text)
sZIP = Trim(shtData.Cells(iRow, ZIP).Text)
sLATITUDE = Trim(shtData.Cells(iRow, LATITUDE).Text)
sLONGITUDE = Trim(shtData.Cells(iRow, LONGITUDE).Text)

'If IsEmpty(Range("L1").Select) = False And IsEmpty(Range("L1").Select) = False Then
If Len(sLATITUDE) > 0 And Len(sLONGITUDE) > 0 Then
sLine = "update nns.gis_address a set a.location=SDO_GEOMETRY(2001, 8307,SDO_POINT_TYPE(" & sLONGITUDE & ", " & sLATITUDE & ",null),null,null), a.geocode_flag='1' where addr_id=" & sADDR_ID & " and party_id=" & sPARTY_ID & " and geocode_flag='0';"
oTextStream.WriteLine sLine
End If
Next
oTextStream.Close
ActiveWindow.Close
'wbkAdresses.Close False
End Sub

 

[Peter_SSs]

Re: How to copy multiple rows, where cells have specific value.

OK, I've split this off from the un-related old thread