Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
nag nag is offline
external usenet poster
 
Posts: 3
Default how to create xls from CSV files

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 he " & 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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
create .xlk files maryj Excel Discussion (Misc queries) 5 May 18th 07 06:10 PM
Help !! - Create files using VBA code Karthik Bhat - Bangalore Excel Programming 2 August 18th 05 05:31 PM
Create a report from different files Tom Velnosky Excel Discussion (Misc queries) 5 July 27th 05 05:24 PM
Create individual files from a row GrahamN Excel Discussion (Misc queries) 3 July 4th 05 10:01 PM
create help files! Aksel Børve Excel Programming 3 February 16th 04 10:29 AM


All times are GMT +1. The time now is 02:12 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"