how to create xls from CSV files

N

NAG

hi with the floowing code.., I could generate the xls file successfully.
But.., when i try to open another file with same macro the file is giving
1004 error.
I get the CSV files( here seperator is ^) depending on the xls file name.


I am able to open the second xls with out any err, if the first window is
closed.

Can anyone help me please??




Sub Macro1()
'
' Macro1 Macro
' Macro recorded 12/20/2005 by
'
'
Dim DefPath As String
Dim MyFullName As String
Dim myFileName As String
Dim isSaveErr As Boolean
Dim isErr As Boolean
Dim htt As String
Dim priceName As String
Dim conditionTab As String
Dim stccTab As String
Dim originTab As String
Dim destTab As String
Dim patronTab As String
Dim uid As String
Dim reportId As String
Dim length As Integer



On Error Resume Next
isErr = True
isSaveErr = True
MyFullName = ThisWorkbook.Path
myFileName = ThisWorkbook.Name
'MsgBox "My Path is...." & myFileName
uid = Mid(myFileName, 1, 6)
reportId = Mid(myFileName, 17)
length = Len(reportId) - 4
reportId = Mid(reportId, 1, length)

'getting file names
'MsgBox "My PRICE is...." & uid & reportId & length
priceName = uid & "PRICE" & reportId & ".txt"
conditionTab = uid & "CONDITION" & reportId & ".txt"
stccTab = uid & "STCC" & reportId & ".txt"
originTab = uid & "ORIGIN" & reportId & ".txt"
destTab = uid & "DESTINATION" & reportId & ".txt"
patronTab = uid & "PATRON" & reportId & ".txt"


If Len(Trim(MyFullName)) < 7 Then
htt = "abcd"
Else
htt = Mid(Trim(MyFullName), 1, 7)
End If
'MsgBox "My 4 Path is...." & htt
' Query runs only for Book.xls
'If myFileName = "Template.xls" Then
If htt = "http://" Or htt = "HTTP://" Then
If ActiveWorkbook.ReadOnly = False Then
ThisWorkbook.ChangeFileAccess xlReadOnly
End If
DefPath = Application.DefaultFilePath
If Right(MyFullName, 1) <> "\" Then
MyFullName = MyFullName & "\"
End If
'On Error GoTo errUpdate
Sheets("UPDATE").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & priceName _
, Destination:=Range("A2"))
.Name = "update"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
errUpdate:
'On Error GoTo errConds
Sheets("CONDITIONS").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & conditionTab _
, Destination:=Range("A2"))
.Name = "conditions"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1)
.Refresh BackgroundQuery:=False
End With
errConds:
'On Error GoTo errStcc
Sheets("STCC").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & stccTab _
, Destination:=Range("A2"))
.Name = "stccs"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
errStcc:
'On Error GoTo errOrigin
Sheets("ORIGIN").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & originTab _
, Destination:=Range("A2"))
.Name = "origin"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
errOrigin:
'On Error GoTo errDest
Sheets("DESTINATION").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & destTab _
, Destination:=Range("A2"))
.Name = "destination"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
errDest:
'On Error GoTo errPatron
Sheets("PATRON").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFullName & patronTab _
, Destination:=Range("A2"))
.Name = "patron"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "^"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
errPatron:
' Formating update tab
Sheets("UPDATE").Select
Rows("1:1").Select
Selection.Columns.AutoFit
Range("B2").Select
'On Error GoTo ErrorHandlerSave
' ActiveWorkbook.SaveAs Filename:= _
' MyFullName & "PRICE_DIVS1.xls", FileFormat:= _
' xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
' , CreateBackup:=False
' MsgBox "Please find the XLS file here: " & MyFullName &
"PRICE_DIV1.xls"
' isSaveErr = False
'ErrorHandlerSave:
' If isSaveErr Then
' MsgBox "Could not save the file to " & MyFullName &
"PRICE_DIV1.xls. Call Prism Support "
' End If


End If ' end if for if the file name is not template.xls
isErr = False
ErrorHandler:
If isErr Then
MsgBox " Error while generating work book"
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with VBA Macro needed 3
Imported text file to begin from the first empty cell 3
.Refresh BackgroundQuery:=False 3
User Select File on Import External Data 3
macro for importing external data 1
How can I automatically import into next empty row 4
Text Importer 2
SOS:why run error 3

Top