Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
create .xlk files | Excel Discussion (Misc queries) | |||
Help !! - Create files using VBA code | Excel Programming | |||
Create a report from different files | Excel Discussion (Misc queries) | |||
Create individual files from a row | Excel Discussion (Misc queries) | |||
create help files! | Excel Programming |