Mr0wyx
02-08-2018, 01:21 PM
Hello,
I know this kind a question came up million times but I cant find mistake. This code works on all machines except one. And I tried different ways to solve by checking permissions in trust center settings and so on but no success. So I think maybe error is in code? Can please someone give advice?
Sub TransasImport_Click()
Dim fileDialog As fileDialog
Dim strPathFile As String
Dim dialogTitle As String
Dim wbSource As Workbook
Dim rngToCopy As Range
Dim rngRow As Range
Dim rngDestin As Range
' Dim lngRowsCopied As Long
Application.ScreenUpdating = False
'Message to select file
MsgBox "Select Transas '.xls' export file."
'Import data from XLS file
dialogTitle = "Navigate to and select required XLS file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
'Call file dialog
With fileDialog
.InitialFileName = "C:\Users\User\Desktop"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "XLS file", "*.xls"
.Title = dialogTitle
If .Show = False Then
MsgBox "File not selected."
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With
Set wbSource = Workbooks.Open(Filename:=strPathFile)
'Clear data in all cells
ThisWorkbook.Sheets("Transas data").Range("A3:L702").Clear
ThisWorkbook.Sheets("Furuno data").Range("B3:R702").Clear
ThisWorkbook.Sheets("Chartworld data").Range("B3:T702").Clear
'Import data code
With wbSource.Worksheets("WAYPOINTS")
Set rngToCopy = .Range(.Cells(2, "A"), .UsedRange.SpecialCells(xlCellTypeLastCell))
For Each rngRow In rngToCopy.Rows
If WorksheetFunction.CountA(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True 'Hides rows with no data
End If
Next rngRow
Set rngDestin = ThisWorkbook.Sheets("Transas data").Cells(3, "A")
rngToCopy.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin
' lngRowsCopied = rngToCopy.Columns(1).SpecialCells(xlCellTypeVisible).Count
' MsgBox lngRowsCopied & " rows copied."
.Rows.Hidden = False 'Unhides previously hidden rows
End With
wbSource.Close SaveChanges:=False
'Clear data in all text boxes
ThisWorkbook.Sheets("Export Data").TextBox1.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox2.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox3.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox4.Text = "-"
'Message data imported
MsgBox "The data was imported.."
End Sub
I know this kind a question came up million times but I cant find mistake. This code works on all machines except one. And I tried different ways to solve by checking permissions in trust center settings and so on but no success. So I think maybe error is in code? Can please someone give advice?
Sub TransasImport_Click()
Dim fileDialog As fileDialog
Dim strPathFile As String
Dim dialogTitle As String
Dim wbSource As Workbook
Dim rngToCopy As Range
Dim rngRow As Range
Dim rngDestin As Range
' Dim lngRowsCopied As Long
Application.ScreenUpdating = False
'Message to select file
MsgBox "Select Transas '.xls' export file."
'Import data from XLS file
dialogTitle = "Navigate to and select required XLS file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
'Call file dialog
With fileDialog
.InitialFileName = "C:\Users\User\Desktop"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "XLS file", "*.xls"
.Title = dialogTitle
If .Show = False Then
MsgBox "File not selected."
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With
Set wbSource = Workbooks.Open(Filename:=strPathFile)
'Clear data in all cells
ThisWorkbook.Sheets("Transas data").Range("A3:L702").Clear
ThisWorkbook.Sheets("Furuno data").Range("B3:R702").Clear
ThisWorkbook.Sheets("Chartworld data").Range("B3:T702").Clear
'Import data code
With wbSource.Worksheets("WAYPOINTS")
Set rngToCopy = .Range(.Cells(2, "A"), .UsedRange.SpecialCells(xlCellTypeLastCell))
For Each rngRow In rngToCopy.Rows
If WorksheetFunction.CountA(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True 'Hides rows with no data
End If
Next rngRow
Set rngDestin = ThisWorkbook.Sheets("Transas data").Cells(3, "A")
rngToCopy.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin
' lngRowsCopied = rngToCopy.Columns(1).SpecialCells(xlCellTypeVisible).Count
' MsgBox lngRowsCopied & " rows copied."
.Rows.Hidden = False 'Unhides previously hidden rows
End With
wbSource.Close SaveChanges:=False
'Clear data in all text boxes
ThisWorkbook.Sheets("Export Data").TextBox1.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox2.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox3.Text = "-"
ThisWorkbook.Sheets("Export Data").TextBox4.Text = "-"
'Message data imported
MsgBox "The data was imported.."
End Sub