CODEWITHSUNDEEP
excelvba
Raju
Raju

Reputation: 1

Export data to text file

I have data in columns a, b, c.
If column b has a certain value then I want to copy the cells with values from that row to the text file in defined path. I am able to create a text file but when copying to the text file am getting error: type mismatch.

Sub createtextfile()     
    Dim sfilename As String
    Dim lastrow As Integer
    Dim i As Integer
    Dim range As Integer
    Dim cellvaue As range
    Dim z As range
    Dim c As range
    Dim strdata As String
    Dim strTempFile As String
    Dim ab As String
    Dim FN As Integer
    
    sfilename = "C:\Users\lourduraju\Desktop\telugu\abc.txt"
    lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
    
    For i = 2 To lastrow
        cellvalue = Worksheets("Sheet1").Cells(i, "B").Value
    
        If cellvalue = 22 Then
            'copycells
            FN = FreeFile
            Open sfilename For Output As #FN
    
            ab = Worksheets("Sheet1").Rows(i).Value
    
            Print #FN, ab
        Else
        End If
    Next
End Sub

Upvotes: 0

Views: 667

Answers (3)

michael
michael

Reputation: 1

Sub EXPORTAR_TXT_ANCHOFIJO()
Dim i As Double
'Creamos autom?ticamente un .txt en blanco que llamamos EJEMPLO
'el archivo se crear? en la misma unidad que tenemos el Excel.
Archivo_txt = ThisWorkbook.Path & "\" & "EJEMPLO.txt"
'si queremos cambiar su ubicaci?n basta con poner Archivo_txt = "E:\EJEMPLO.txt"
Open Archivo_txt For Output As #1

With Sheets(1)
fin = Application.CountA(Range("A:A"))

For i = 2 To fin
'Asignamos a cada Campo la funci?n que necesitamos aplicar
Campo1 = C_Der(.Cells(i, 1), 20)
Campo2 = C_Der(.Cells(i, 2), 23)
Campo3 = C_Der(.Cells(i, 3), 28)
Campo4 = C_Izq(.Cells(i, 4), 4)

Print #1, Campo1 & Campo2 & Campo3 & Campo4

Next i

Close
End With
End Sub


Function C_Izq(ByVal sCadena As String, ByVal nLargo As Integer, Optional sCaracter As Variant) As String

    'Creamos cadena para rellenar por la izquierda con el caracter indicado

    Dim sValor As String

    If IsMissing(sCaracter) Then sCaracter = "0"

    sCadena = Trim(sCadena)
    If Len(sCadena) > nLargo Then sCadena = Right(sCadena, nLargo)
    sValor = String(nLargo - Len(sCadena), sCaracter) & sCadena
    C_Izq = sValor

End Function
Function C_Der(ByVal sCadena As String, ByVal nLargo As Integer, Optional sCaracter As Variant) As String

    'Creamos cadena para rellenar por la derecha con el caracter indicado

    Dim sValor As String

    If IsMissing(sCaracter) Then sCaracter = Space(1)
    
    sCadena = Trim(sCadena)
    If Len(sCadena) > nLargo Then sCadena = Left(sCadena, nLargo)
    sValor = sCadena & String(nLargo - Len(sCadena), sCaracter)
    C_Der = sValor

End Function

Upvotes: 0

Domenic
Domenic

Reputation: 8104

First, I would recommend that you always include the Option Explicit statement at the top of your module. This forces the explicit declaration of variables, and would have caught one of your errors -- a spelling mistake when declaring cellvalue.

As VinhCC has already mentioned, since cellvalue is being assigned a value, it should be declared as a Variant, not a Range.

Have a look at the following code, which has been re-written according to your last instructions... 

Option Explicit

Sub CreateTextFiles()

    Dim vData As Variant
    Dim vRow As Variant
    Dim vFileNumbers As Variant
    Dim sPath As String
    Dim sFilename As String
    Dim sText As String
    Dim iFileNum As Integer
    Dim LastRow As Long
    Dim i As Long
    Dim j As Long

    sPath = "C:\Users\lourduraju\Desktop\telugu\"
    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If

    vData = Worksheets("Sheet1").UsedRange.Value

    vFileNumbers = Array(22, 25, 33, 36) 'add other numbers as desired

    For i = LBound(vFileNumbers) To UBound(vFileNumbers)
        sFilename = sPath & "abc" & vFileNumbers(i) & ".txt"
        iFileNum = FreeFile()
        Open sFilename For Output As #iFileNum
            For j = 2 To UBound(vData) 'start at the second row of data
                If vData(j, 2) = vFileNumbers(i) Then
                    vRow = Application.Index(vData, j, 0)
                    sText = Join(vRow, "")
                    Print #iFileNum, sText
                End If
            Next j
        Close #iFileNum
    Next i

End Sub

Edit

To format the first column to 7 digits, add the following line after Application.Index...

vRow(1) = Format(vRow(1), "0000000") 'format first column (1 = first column; 2 = second column; etc ... )

Upvotes: 1

Vinh Can Code
Vinh Can Code

Reputation: 427

I think that the cellvaue could be Variant

Sub createtextfile()     
  Dim sfilename As String
  Dim lastrow As Integer
  Dim i As Integer
  Dim range As Integer
  Dim cellvaue ' As range   <<- It should be Variant 
  Dim z As range
  Dim c As range
  Dim strdata As String
  Dim strTempFile As String
  Dim ab As String
  Dim FN As Integer

  sfilename = "C:\Users\lourduraju\Desktop\telugu\abc.txt"
  lastrow = Worksheets("Sheet1").UsedRange.Rows.Count

  For i = 2 To lastrow
      cellvalue = Worksheets("Sheet1").Cells(i, "B").Value

      If cellvalue = 22 Then
        'copycells
        FN = FreeFile
        Open sfilename For Output As #FN

        ab = Worksheets("Sheet1").Rows(i).Value

        Print #FN, ab
      Else
      End If
  Next
End Sub

Upvotes: 0

Related Questions