k=1; S={2,7};
a[n_] := (
While[Length@S<n, S=S~Join~IntegerDigits[S[[k]]*S[[k+1]]]; ++k];
S[[n]]
)

a[10]

FromDigits[a /@ Range[10000]]

a[10000]