txtfile

form:
Option Compare Database
Option Explicit

Private Sub btnBrowse_Click()

Dim filter As New DialogFilter
Dim result As OpenFileDialogResult

filter.Description = “Delim. Files”
filter.Extenstions = “*.csv, *.txt”

Set result = SelectingFile.OpenFileDialog(“Select a file to import”, False, filter)

If result.Successful Then
Me.txtFileName = result.FileName
Me.txtErrMessage = Null

Else
Me.txtErrMessage = result.ErrorMessage
End If

End Sub

Private Sub btnImport_Click()
Dim result As ImportTXTFileResult
Dim params As New ImportTXTProductsParams

Me.txtErrMessage = Null

If IsNull(Me.txtFileName) Then
Me.txtErrMessage = “Please select a File!”

Exit Sub

End If

If IsNull(Me.cboImportFileType) Then
Me.txtErrMessage = “Please select a file type!”

Exit Sub

End If

params.FileName = Me.txtFileName
params.hasHeaders = True
params.SpecificationName = Me.cboImportFileType
params.TableName = “PRODUCTS”

Set result = ImportingFile.ImportTXTProducts(params)

If result.Successful Then
MsgBox “Import successful!”, vbOKOnly, “Success!”

Else
Me.txtErrMessage = result.ErrorMessage

End If
End Sub

 

modules
a) importing
Option Compare Database
Option Explicit

Public Function ImportTXTProducts(params As ImportTXTProductsParams) As ImportTXTFileResult
Dim result As New ImportTXTFileResult
Dim FSO As New FileSystemObject
Dim TXT As TextStream
Dim FileData As String
Dim FileDelim As String

‘
‘On Error GoTo ImportProblem

If Not FSO.FileExists(params.FileName) Then
result.Successful = False
result.ErrorMessage = “File Not Found!”
Set ImportTXTProducts = result

Exit Function

End If

Set TXT = FSO.OpenTextFile(params.FileName, ForReading)
FileData = TXT.ReadAll
TXT.Close

FileDelim = DLookup(“FieldSeparator”, “MSysIMEXSpecs”, “SpecName='” & params.SpecificationName & “‘”)

If InStr(1, FileData, FileDelim) = 0 Then
result.Successful = False
result.ErrorMessage = “Incorrect File Type”
Set ImportTXTProducts = result

Exit Function

End If

DoCmd.TransferText acImportDelim, params.SpecificationName, params.TableName, params.FileName, params.hasHeaders

result.Successful = True
Set ImportTXTProducts = result

Exit Function
‘
‘ImportProblem:
‘ result.Successful = False
‘ result.ErrorMessage = Err.Description

Set ImportTXTProducts = result
End Function
b) selecting
Option Compare Database
Option Explicit

Public Function OpenFileDialog(Title As String, AllowMultiSelect As Boolean, DialogFilter As DialogFilter) As OpenFileDialogResult

Dim diag As FileDialog
Dim item As Variant
Dim result As New OpenFileDialogResult

Set diag = Application.FileDialog(msoFileDialogFilePicker)

diag.AllowMultiSelect = AllowMultiSelect
diag.Title = Title
diag.Filters.Clear
diag.Filters.Add DialogFilter.Description, DialogFilter.Extenstions

If diag.Show Then
For Each item In diag.SelectedItems

result.FileName = CStr(item)
result.Successful = True

Next

Else
result.Successful = False
result.ErrorMessage = “No file selected!”
End If

Set OpenFileDialog = result

End Function

 

 

classes
1) DialogFilter
Option Compare Database
Option Explicit

Public Description As String
Public Extenstions As String

2) ImportTXTFileResult
Option Compare Database
Option Explicit

Public Successful As Boolean
Public ErrorMessage As String
3) ImportTXTProductsParams
Option Compare Database
Option Explicit

Public SpecificationName As String
Public TableName As String
Public FileName As String
Public hasHeaders As Boolean
4) OpenFileDialogResult
Option Compare Database
Option Explicit

Public Successful As Boolean
Public ErrorMessage As String
Public FileName As String

 

28.09.2019

Option Explicit

Sub Finalsteps()

Columns(6).Select
Range(Selection, Selection.End(xlToRight)).EntireColumn.Hidden = True
Rows(“24:24”).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Hidden = True

Range(“A1:E1”).Select
With Selection
.Interior.Color = 12611584
.Font.ThemeColor = xlThemeColorDark1

End With

Range(“A2:E23”).Interior.ThemeColor = xlThemeColorAccent5

Range(“A1”).Select

Cells.EntireColumn.AutoFit
Call SaveWPass
End Sub
Sub SaveWPass()

Dim Ownpass As Variant

Ownpass = InputBox(“Please enter password to protect document”, “Save with password”, “pass”)

MsgBox “Created password: ” & Ownpass & ” .Set password will be required to open this Workbook next time.”

With Application
.DisplayAlerts = False
.ScreenUpdating = False

With ActiveWorkbook

.SaveAs Filename:=”C:\Users\Agnieszka\Desktop\Macro_protected.xlsm”, FileFormat:=52, Password:=Ownpass, WriteResPassword:=””, _
ReadOnlyRecommended:=False, CreateBackup:=False

.Close
End With

.ScreenUpdating = True
.DisplayAlerts = True
End With

End Sub