I am fresher to computer. I just have added a macro in Excel Addin in a
separate module. I am getting error No. 13, while running this. I want
to use this in all file. Kindly help me
Sub TEXTFILE()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo ErrHandler:
'Now i will activate notepad and open/create one file
'"Windows Scripting Runtime"(SCRRUN.DLL)--reference to be activated
Dim txtfile As Characters ' TextStream
'Dim fso As New Scripting.FileSystemObject
Dim sFile As Variant 'String
sFile = Application.GetSaveAsFilename(InitialFileName:=txtfilename(),
FileFilter:="Text Files (*.txt), *.txt")
If sFile = "False" Then Exit Sub
If sFile Then 'If fso.FileExists(sFile) Then
Kill sFile
Set txtfile = fso.CreateTextFile(sFile, True)
Else
Set txtfile = fso.CreateTextFile(sFile, True)
End If
'now i will write details of records.
ActiveWorkbook.Sheets("ECR").Select 'Sheets("Sheet1").Select
For Decount = 1 To ActiveSheet.UsedRange.Rows.Count - 1
d = "#~#"
DD1 = Left(Cells(Decount + 1, 1), 7)
DD2 = UCase(Cells(Decount + 1, 2))
DD3 = Left(Cells(Decount + 1, 3), 10)
DD4 = Left(Cells(Decount + 1, 4), 10)
DD5 = Left(Cells(Decount + 1, 5), 10)
DD6 = Left(Cells(Decount + 1, 6), 10)
DD7 = Left(Cells(Decount + 1, 7), 10)
DD8 = Left(Cells(Decount + 1, 8), 10)
DD9 = Left(Cells(Decount + 1, 9), 10)
DD10 = Left(Cells(Decount + 1, 10), 10)
If Cells(Decount + 1, 11) > 0 Then
DD11 = Left(Cells(Decount + 1, 11), 2)
Else
DD11 = 0
End If
If Cells(Decount + 1, 12) > 0 Then
DD12 = Left(Cells(Decount + 1, 12), 10)
Else
DD12 = 0
End If
If Cells(Decount + 1, 13) > 0 Then
DD13 = Left(Cells(Decount + 1, 13), 10)
Else
DD13 = 0
End If
If Cells(Decount + 1, 14) > 0 Then
DD14 = Left(Cells(Decount + 1, 14), 10)
Else
DD14 = 0
End If
If Cells(Decount + 1, 15) > 0 Then
DD15 = Left(Cells(Decount + 1, 15), 10)
Else
DD15 = 0
End If
If Cells(Decount + 1, 16) > 0 Then
DD16 = Left(Cells(Decount + 1, 16), 10)
Else
DD16 = 0
End If
DD17 = UCase(Cells(Decount + 1, 17))
DD18 = UCase(Left(Cells(Decount + 1, 18), 1))
If Cells(Decount + 1, 19) > 0 Then
DD19 = Right("00" & Day(Cells(Decount + 1, 19)), 2) & "/" & _
Right("00" & Month(Cells(Decount + 1, 19)), 2) & "/" & _
Year(Cells(Decount + 1, 19))
Else
DD19 = ""
End If
DD20 = UCase(Left(Cells(Decount + 1, 20), 1))
If Cells(Decount + 1, 21) > 0 Then
DD21 = Right("00" & Day(Cells(Decount + 1, 21)), 2) & "/" & _
Right("00" & Month(Cells(Decount + 1, 21)), 2) & "/" & _
Year(Cells(Decount + 1, 21))
Else
DD21 = ""
End If
If Cells(Decount + 1, 22) > 0 Then
DD22 = Right("00" & Day(Cells(Decount + 1, 22)), 2) & "/" & _
Right("00" & Month(Cells(Decount + 1, 22)), 2) & "/" & _
Year(Cells(Decount + 1, 22))
Else
DD22 = ""
End If
If Cells(Decount + 1, 23) > 0 Then
DD23 = Right("00" & Day(Cells(Decount + 1, 23)), 2) & "/" & _
Right("00" & Month(Cells(Decount + 1, 23)), 2) & "/" & _
Year(Cells(Decount + 1, 23))
Else
DD23 = ""
End If
If Cells(Decount + 1, 24) > 0 Then
DD24 = Right("00" & Day(Cells(Decount + 1, 24)), 2) & "/" & _
Right("00" & Month(Cells(Decount + 1, 24)), 2) & "/" & _
Year(Cells(Decount + 1, 24))
Else
DD24 = ""
End If
DD25 = Left(Cells(Decount + 1, 25), 1)
'-------------------------
txtfile.WriteLine (DD1 & d & DD2 & d & DD3 & d & DD4 & d & DD5 & d & DD6 &
d & DD7 & _
d & DD8 & d & DD9 & d & DD10 & d & DD11 & d & DD12 & d & DD13 & d &
DD14 & d _
& DD15 & d & DD16 & d & DD17 & d & DD18 & d & DD19 & d & DD20 & d &
DD21 & d _
& DD22 & d & DD23 & d & DD24 & d & DD25)
'-------------------------
Next Decount
MsgBox "The text file is saved as " & sFile
Sheets("Textmain").Select
Exit Sub
ErrHandler:
If Err.Number = 13 Then
MsgBox "Vba Error Code 13 - Data Type Mismatch. The date in Row Number
" _
& Decount + 1 & " is not in the date format"
Else
MsgBox "Vba Error Code " & Err.Number & " - " & Err.Description & _
". Textfile is not created successfully."
GoTo ExitFunction:
End If
ExitFunction:
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function txtfilename() As String
' Dim c As String
' Dim y As String
' Dim m As String
' Dim t As String
'
' Sheets("Textmain").Select
' c = Left(Cells(2, 8), 2) & Left(Cells(2, 9), 3) & _
' Right("00000" & Cells(2, 10), 5) & 0
' y = Left(Year(Cells(4, 10)), 4)
' m = Right("00" & Month(Cells(4, 10)), 2)
' t = ".txt"
' txtfilename = c + y + m + t
Dim m As String
Dim t As String
m = Format(Now(), "mmm-yyyy ")
t = ".txt"
txtfilename = m + t
End Function
--
Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To post to this group, send email to excel-macros@googlegroups.com.
To unsubscribe from this group, send email to
excel-macros+unsubscr...@googlegroups.com.
Visit this group at http://groups.google.com/group/excel-macros?hl=en.
