deciphering code for clean export import...help please

[opie_18]

Hi,

I really hope you all can help and thanks in advance...

This code was written to extract data and then dump it in an export file...

Problem is the export file puts the date as such:
"BudgetDate","Hotel","Account","AcctType","Amount"
#2005-01-31#,"AB","199-41000","M","81.00"
#2005-02-28#,"AB","199-41000","M","81.00"
#2005-03-31#,"AB","199-41000","M","81.00"
#2005-04-30#,"AB","199-41000","M","81.00"
#2005-05-31#,"AB","199-41000","M","81.00"

These "#" prevent me from importing into Access, well it puts them in the Access table with the "#"... can't have.

I am trying to decipher the code to see where those are put in at... no luck

Here is the code

Sub RunStripper()
Dim rAccts As Range
Dim iBudYr As Integer
Dim sHotCode As String
Dim sExportFile As String
Dim iRecCnt As Long
Dim iFile As Integer
Dim rCell As Range
Dim iOffset As Integer

On Error GoTo ErrTrap

If Len(ThisWorkbook.Path) = 0 Then
MsgBox "Save This Workbook Before Attempting To Run The Stripper.", vbInformation, "Save Workbook"
Exit Sub
End If

Application.ScreenUpdating = False
ThisWorkbook.Activate
Worksheets("Statement").Activate
ActiveSheet.Unprotect sPWD
Calculate
Application.Calculation = xlCalculationManual
ActiveSheet.UsedRange.Rows.Hidden = False
Columns("A").Hidden = False

Set rAccts = Columns("A").SpecialCells(xlCellTypeConstants)

iBudYr = Worksheets("Hotel Info").Range("BudYr").Value
sHotCode = Worksheets("Hotel Info").Range("HotelCode").Value
sExportFile = ThisWorkbook.Path & "\" & sHotCode & "_BudgetExtract.txt"
iRecCnt = 0
iFile = FreeFile()

Open sExportFile For Output As #iFile
Print #iFile, "ID,BudDate,Acct,Amt,Type"

For Each rCell In rAccts
If Mid$(rCell.Value, 4, 1) = "-" Then
For iOffset = 3 To 14
If Application.Round(rCell.Offset(0, iOffset).Value, 2) <> 0 Then
Print #iFile, sHotCode & "," & Format(DateSerial(iBudYr, iOffset - 2, Day(DateSerial(iBudYr, iOffset - 1, 0))), "m/d/yyyy") & _
"," & rCell.Value & "," & rCell.Offset(0, iOffset).Value & ",M"
iRecCnt = iRecCnt + 1
End If
Next iOffset
End If
Next rCell

Worksheets("DBD Entry").Activate
Dim rOutput As Range
Dim iMonth As Integer
Dim iTotalRow1 As Integer
Dim iWk As Integer
Dim iWkRow1 As Integer
Dim iDayCol As Integer
Dim iAmtOffset As Integer

Set rOutput = Worksheets("Tables").Range("DBD_Output")
iMonth = 1

For iTotalRow1 = 8 To 1207 Step 109
For iOffset = 0 To 11
rOutput.Cells(iOffset + 1, 4).Value = Range("C" & iTotalRow1).Offset(iOffset, 0).Value
rOutput.Cells(iOffset + 1, 5).Value = Range("D" & iTotalRow1).Offset(iOffset, 0).Value
Next iOffset
For iWk = 1 To 6
iWkRow1 = iTotalRow1 + (iWk * 15)
For iDayCol = 0 To 6
If Len(Range("F" & iWkRow1).Offset(-1, iDayCol).Value) <> 0 Then
For iAmtOffset = 0 To 11
rOutput.Cells(iAmtOffset + 1, 4).Value = Range("F" & iWkRow1).Offset(iAmtOffset, iDayCol).Value
Next iAmtOffset
rOutput.Calculate
For Each rCell In rOutput.Columns(1).Cells
If rCell.Offset(0, 3).Value <> 0 Then
Print #iFile, sHotCode & "," & Format(Range("F" & iWkRow1).Offset(-1, iDayCol).Value, "m/d/yyyy") & _
"," & rCell.Offset(0, 1).Value & "," & rCell.Offset(0, 3).Value & ",D"
iRecCnt = iRecCnt + 1
Print #iFile, sHotCode & "," & Format(Range("F" & iWkRow1).Offset(-1, iDayCol).Value, "m/d/yyyy") & _
"," & rCell.Offset(0, 2).Value & "," & rCell.Offset(0, 5).Value & ",D"
iRecCnt = iRecCnt + 1
End If
Next rCell
End If
Next iDayCol
Next iWk
iMonth = iMonth + 1
Next iTotalRow1

If iRecCnt = 0 Then
MsgBox "There Were No Exportable Records Found.", vbInformation, "Budget Stripper"
Else
MsgBox "Budget Records Were Exported To The Following Path:" & vbCr & vbCr & sExportFile, vbInformation, "Budget Stripper"
End If

EndOfSub:
Close #iFile
Worksheets("Statement").Activate
Columns("A").Hidden = True
HideUtilityRows
HideZeroRows
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveSheet.Protect sPWD
Exit Sub
ErrTrap:
MsgBox "An Error Occurred Attempting To Strip The Budget." & vbCr & vbCr & "Error Number: " & _
Err.Number & vbCr & "Error Description: " & Err.Description, vbCritical, "Error @ RunStripper"
Resume EndOfSub
End Sub

Thanks again...

John