PDA

View Full Version : Need help with Import and exporting a file



lucpian
02-06-2008, 10:05 AM
Hi All,

Good day. Please, I need help with workable vba codes for importing a text file into an Excel template, and an export code for exporting the Excel file into a text file with an extension of .txt or .csv. I will also need a code to check entries in column G in the workbook to ensure that it is only "Y" or "M". The following are my codes, but they are not working.

Public Sub ExportingXlsFilestoCAPRS(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

' ExportToTextFile
' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoTheExport
' This prompts the user for the FileName and the separtor
' character and then calls the ExportToTextFile procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoTheExport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
If FileName = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Sep = Application.InputBox("Enter a separator character.", Type:=2)
If Sep = vbNullString Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Separator: " & Sep
ExportingXlsFilestoCAPRS FName:=CStr(FileName), Sep:=CStr(Sep), _
SelectionOnly:=False, AppendData:=True
End Sub

Public Sub ImportingXlsFilesintoTemplate(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportTextFile
' This imports a text file into Excel.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoTheImport
' This prompts the user for a FileName as separator character
' and then calls ImportTextFile.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoTheImport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetOpenFilename(FileFilter:="Excel File (*.xls),*.txt")
If FileName = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Sep = Application.InputBox("Enter a separator character.", Type:=2)
If Sep = vbNullString Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Separator: " & Sep
ImportingXlsFilesintoTemplate FName:=CStr(FileName), Sep:=CStr(Sep)
End Sub

Sub MaintenanceFreqCheckingbutton()
Dim strVal As String
Dim rRng As Range
Dim Cols As Integer
'Dim Rows As Integer
Dim C As Integer
Dim R As Integer
Dim dDate As String
Dim LastRow As Long
Dim cell As Range
Dim col As Range
Dim msg As String
Dim i As Long
Dim Y As String
Dim M As String
'Set rRng = Range(B).Select
'Selection.NumberFormat = "dd/mm/yyyy"


For Each col In Range("Q:Q").Columns

LastRow = Cells(Rows.Count, col.Column).End(xlUp).Row
For Each cell In Cells(2, col.Column).Resize(LastRow)


If ((cell.Value = "Y") Or (cell.Value = "M")) Then

MsgBox "Correct values"

Else

msg = msg & cell.Address(False, False) & " - " & cell.Value & vbNewLine
End If
Next cell
Next col

MsgBox msg

End Sub

Thanks for helping me out.

Lucpian