Link to home
Create AccountLog in
Avatar of UWW_Jax
UWW_JaxFlag for United States of America

asked on

Access VBA Saving Excel as txt

I'm trying to create a peice of code that looks at an excel file and does the following for each file. (4 files)
1) open files
2) updated number formats
3) inserts a new column (d)
4) updates formula in d for each record that exist with "x" and same row but column c
5) then save as txt demilited.

Here's the purpose:  column c has more that 15 numbers that are all needed and should be referenced as a text.  I'd tried "@" and "###0". neither of them worked so I wanted to insert a new column (d) with X at the beginning hoping that it would keep the info.

Here's the code I have the hickup is found in For Each C In Range("$D2:$D" & xcend).Cells. I keep getting a error message I don't know how to resolve.  Plus if it errors. the file is invisible open. I have to pass on reopening the file and then close just to try again.  Any ideas?

Method 'Range' of 'object' Global Failed


Function XlsFileAsTxt()
'On Error GoTo Xerror

'******Create Date for File
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Qry_DL_IM_Vendors"
    DoCmd.SetWarnings True
    TempVars.Add "STR_IP_MMDD", InputBox("Enter Month MM and Day DD ex 0923", "Info Request")


'******Create MA File and load

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet


    TempVars.Add "STR_IP_XXMMDD", "MA_" & Format([TempVars]![str_IP_MMDD], "0000")
Dim DirXYZ As String
DirXYZ = "P:\DATABASE\Inter Brance Transfer\Inputs\IMPAREPT\"

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".xls")
Set xlSheet = xlBook.worksheets(1)
xlSheet.Activate
 Dim C As Range
 Dim CCV As String
 Dim CCVPos As Integer
 Dim CCVi As Integer ' going to be row
 Dim CCVt As String  ' going to be column
 Dim xcend As Integer
 
    xlSheet.Rows("1:4").Delete
    xlSheet.Columns("C:C").NumberFormat = "###0"
    xlSheet.Columns("I:I").NumberFormat = "@"
    xlSheet.Columns("H:H").NumberFormat = "00000000"
    xlSheet.Columns("A:A").NumberFormat = "@"
    xlSheet.Columns("B:B").NumberFormat = "@"
    xlSheet.Columns("D:D").NumberFormat = "@"
    xlSheet.Columns("E:E").NumberFormat = "0"
    xlSheet.Columns("F:F").NumberFormat = "0.00"
    xlSheet.Columns("G:G").NumberFormat = "@"
    xlSheet.Columns("D:D").Insert shift:=xlToRight
    xlSheet.Cells(1, 4).Value = "ItemConv"
    xcend = xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each C In Range("$D2:$D" & xcend).Cells
    CCV = C.Address
    CCVPos = InStr(2, CCV, "$", vbTextCompare)
    CCVi = Mid(CCV, CCVPos)
    'CCVt = "D"
    'Xcol = "$" & Chr(Asc(CCVt) - 1)
    
    'C.Value = "'" & Left(Range("$C" & "$" & CCVi).Text, Len(Range("$C" & "$" & CCVi).Text) - Len((Range("$A" & "$" & CCVi).Text)))
    If Len(Range("$C" & "$" & CCVi).Text) > 0 Then
    C.Value = "x" & Range("$C" & "$" & CCVi).Text
    End If
    Next

    
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & "1.xls", xlWorkbook
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", xltext
xlBook.Close SaveChanges:=False

DoCmd.TransferText acImportDelim, "IMPAREPT_IS1", "Tbl_Import_IMPAREPT", DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", True, ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "Qry_UP_IM_Imparept_Date"
DoCmd.SetWarnings True


'******Create SW File and load
    TempVars.Add "STR_IP_XXMMDD", "SW_" & Format([TempVars]![str_IP_MMDD], "0000")

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".xls")
Set xlSheet = xlBook.worksheets(1)
xlSheet.Activate

 Dim D As Range
 Dim DDV As String
 Dim DDVPos As Integer
 Dim DDVi As Integer ' going to be row
 Dim DDVt As String  ' going to be column
 Dim xdend As Integer
    xlSheet.Rows("1:4").Delete
    xlSheet.Columns("C:C").NumberFormat = "###0"
    xlSheet.Columns("I:I").NumberFormat = "@"
    xlSheet.Columns("H:H").NumberFormat = "@"
    xlSheet.Columns("A:A").NumberFormat = "@"
    xlSheet.Columns("B:B").NumberFormat = "@"
    xlSheet.Columns("D:D").NumberFormat = "@"
    xlSheet.Columns("E:E").NumberFormat = "0"
    xlSheet.Columns("F:F").NumberFormat = "0.00"
    xlSheet.Columns("G:G").NumberFormat = "@"
    xlSheet.Columns("D:D").Insert shift:=xlToRight
        'MsgBox xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        xlSheet.Cells(1, 4).Value = "ItemConv"

    xdend = xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each D In Range("$D2:$D" & xdend).Cells
    DDV = D.Address
    DDVPos = InStr(2, DDV, "$", vbTextCompare)
    DDVi = Mid(DDV, DDVPos)
    'CCVt = "D"
    'Xcol = "$" & Chr(Asc(CCVt) - 1)
    
    'C.Value = "'" & Left(Range("$C" & "$" & CCVi).Text, Len(Range("$C" & "$" & CCVi).Text) - Len((Range("$A" & "$" & CCVi).Text)))
    If Len(Range("$C" & "$" & DDVi).Text) > 0 Then
    D.Value = "x" & Range("$C" & "$" & DDVi).Text
    End If
    Next
    
 xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & "1.xls", xlWorkbook
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", xltext
xlBook.Close SaveChanges:=False
xlApp.Quit
DoCmd.TransferText acImportDelim, "IMPAREPT_IS1", "Tbl_Import_IMPAREPT", DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", True, ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "Qry_UP_IM_Imparept_Date"
DoCmd.SetWarnings True

'******Create PC File and load
    TempVars.Add "STR_IP_XXMMDD", "PC_" & Format([TempVars]![str_IP_MMDD], "0000")

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".xls")
Set xlSheet = xlBook.worksheets(1)
 Dim E As Range
 Dim EEV As String
 Dim EEVPos As Integer
 Dim EEVi As Integer ' going to be row
 Dim EEVt As String  ' going to be column
 Dim xEend As Integer

    xlSheet.Rows("1:4").Delete
    xlSheet.Columns("C:C").NumberFormat = "###0"
    xlSheet.Columns("I:I").NumberFormat = "@"
    xlSheet.Columns("H:H").NumberFormat = "@"
    xlSheet.Columns("A:A").NumberFormat = "@"
    xlSheet.Columns("B:B").NumberFormat = "@"
    xlSheet.Columns("D:D").NumberFormat = "@"
    xlSheet.Columns("E:E").NumberFormat = "0"
    xlSheet.Columns("F:F").NumberFormat = "0.00"
    xlSheet.Columns("G:G").NumberFormat = "@"
    xlSheet.Columns("D:D").Insert shift:=xlToRight
    'MsgBox xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        xlSheet.Cells(1, 4).Value = "ItemConv"


    xEend = xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each E In Range("$D2:$D" & xEend).Cells
    EEV = E.Address
    EEVPos = InStr(2, EEV, "$", vbTextCompare)
    EEVi = Mid(EEV, EEVPos)
    'CCVt = "D"
    'Xcol = "$" & Chr(Asc(CCVt) - 1)
    
    'C.Value = "'" & Left(Range("$C" & "$" & CCVi).Text, Len(Range("$C" & "$" & CCVi).Text) - Len((Range("$A" & "$" & CCVi).Text)))
    If Len(Range("$C" & "$" & EEVi).Text) > 0 Then
    E.Value = "x" & Range("$C" & "$" & EEVi).Text
    End If
    Next
        
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & "1.xls", xlWorkbook
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", xltext
xlBook.Close SaveChanges:=False
xlApp.Quit
DoCmd.TransferText acImportDelim, "IMPAREPT_IS1", "Tbl_Import_IMPAREPT", DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", True, ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "Qry_UP_IM_Imparept_Date"
DoCmd.SetWarnings True



'******Create NU File and load
    TempVars.Add "STR_IP_XXMMDD", "NU_" & Format([TempVars]![str_IP_MMDD], "0000")

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".xls")
Set xlSheet = xlBook.worksheets(1)
xlSheet.Activate
 Dim F As Range
 Dim FFV As String
 Dim FFVPos As Integer
 Dim FFVi As Integer ' going to be row
 Dim FFVt As String  ' going to be column
 Dim xFend As Integer
 
    xlSheet.Rows("1:4").Delete
    xlSheet.Columns("C:C").NumberFormat = "###0"
    xlSheet.Columns("I:I").NumberFormat = "@"
    xlSheet.Columns("H:H").NumberFormat = "@"
    xlSheet.Columns("A:A").NumberFormat = "@"
    xlSheet.Columns("B:B").NumberFormat = "@"
    xlSheet.Columns("D:D").NumberFormat = "@"
    xlSheet.Columns("E:E").NumberFormat = "0"
    xlSheet.Columns("F:F").NumberFormat = "0.00"
    xlSheet.Columns("G:G").NumberFormat = "@"
    xlSheet.Columns("D:D").Insert shift:=xlToRight
        xlSheet.Cells(1, 4).Value = "ItemConv"
    'MsgBox xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    xFend = xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each F In Range("$D2:$D" & xFend).Cells
    FFV = F.Address
    FFVPos = InStr(2, FFV, "$", vbTextCompare)
    FFVi = Mid(FFV, FFVPos)
    'CCVt = "D"
    'Xcol = "$" & Chr(Asc(CCVt) - 1)
    
    'C.Value = "'" & Left(Range("$C" & "$" & CCVi).Text, Len(Range("$C" & "$" & CCVi).Text) - Len((Range("$A" & "$" & CCVi).Text)))
    If Len(Range("$C" & "$" & FFVi).Text) > 0 Then
    F.Value = "x" & Range("$C" & "$" & FFVi).Text
    End If
    Next

xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & "1.xls", xlWorkbook
xlBook.SaveAs DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", xltext
xlBook.Close SaveChanges:=False
xlApp.Quit
DoCmd.TransferText acImportDelim, "IMPAREPT_IS1", "Tbl_Import_IMPAREPT", DirXYZ & "IMPAREPT_" & TempVars!str_IP_XXMMDD & ".txt", True, ""

DoCmd.SetWarnings False
DoCmd.OpenQuery "Qry_UP_IM_Imparept_Date"
DoCmd.OpenQuery "Qry_AP_IMPAREPT"
DoCmd.SetWarnings True


xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

xerror:
MsgBox Err.Description
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing


End Function

Open in new window

Avatar of UWW_Jax
UWW_Jax
Flag of United States of America image

ASKER

I did find the MS help, but I could not get it work either.
http://support.microsoft.com/default.aspx?kbid=178510
Avatar of UWW_Jax

ASKER

I also Tried t add. xlsheet.      .cells

the first instance always works.  its the second part that fails.
ASKER CERTIFIED SOLUTION
Avatar of tonybran
tonybran

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Norie
Norie

Have you checked the value of xcend?

Also, what exactly are you trying to achieve and why are you using Excel if you want text files?

Is the original data in Excel?

If it is why not just import it into Access (I think that's where you are working from), use code to run some update queries (or even loop through the data) and then export to text?

Am I missing the point?
Why don't you just import the worksheets directly into Access, using the TransferSpreadsheet method, and then do any necessary calculations or data type conversions in a query.  You could then export the massaged data to a comma-delimited file using the TransferText method.  Here is some sample code:  
DoCmd.TransferSpreadsheet transfertype:=acImport, _
   spreadsheettype:=acSpreadsheetTypeExcel9, _
   tablename:=strTable, _
   FileName:=strWorkbook, _ 
   hasfieldnames:=True, _
   Range:=strRange

=====================
   DoCmd.TransferText transfertype:=acExportDelim, _
      tablename:="tblCustomers", _
      FileName:="D:\Documents\Examples\Export Delimited.csv", _
      hasfieldnames:=True

Open in new window

Avatar of UWW_Jax

ASKER

I tryied to import as xls, but some of the data has numbers and text and the text keeps getting dropped.  The xcend is suppose to the the last cell that has data,  this way the caculation does not happen for every cell in the column only the ones that are being used but the proir column.

I'm trying to aviod opening the file except through automation.

I thougth I need to be using xlsheet.range  but I could not get it to work.
Avatar of UWW_Jax

ASKER

make sure xlsheet. is used for every instance of range().cells